VBA 取对应坐标值, 相减及标示

On_fire

VBA 取对应坐标值, 相减及标示

*

Sheet1是源数据,

Range(“C71:Q82”)是要判断及处理的区域,

C83~Q83列是X轴, 数值是给的, 是变量( 有合并格 )

B71~B82行是Y轴, 数值是给的, 是变量

*

代码逻辑如下,

1.      左到右, 顺序先取第83行的列值

2.      上到下, 再取第B列的行值

3.      列值, 减去, 行值, 等于结果, 输出到同列的第69行

4.      根据相减结果, 负值标蓝, 正值标红

*

模拟过程及结果在Sheet1(2)

*

恳请大神, 老师出手帮忙…!!!

于箱长

前排看热闹

gwjkkkkk

Sub TEST()
    Dim arr, vData, i&, j&, iNum&, Rng As Range
   
    arr = [B71].CurrentRegion
    ReDim vData(1 To UBound(arr, 2) - 1)
    For i = 2 To UBound(arr, 2)
        If arr(UBound(arr), i) <> "" Then
           iNum = arr(UBound(arr), i)
        End If
        For j = 1 To UBound(arr)
            If arr(j, i) <> "" Then
               vData(i - 1) = iNum & "-" & arr(j, 1) & "=" & iNum - arr(j, 1)
               Exit For
            End If
        Next j
    Next i
   
    Set Rng = [C69].Resize(, UBound(arr, 2) - 1)
    With Rng
        .Interior.ColorIndex = xlNone
        .Value = vData
        For i = 1 To UBound(vData)
            If Val(Split(vData(i), "=")(1)) < 0 Then
               .Cells(i).Interior.Color = vbCyan
            ElseIf Val(Split(vData(i), "=")(1)) > 0 Then
               .Cells(i).Interior.Color = vbRed
            End If
        Next
    End With
    Beep
End Sub

gwjkkkkk

请楼主参考附件。。。

On_fire

gwjkkkkk 发表于 2022-12-23 19:07
请楼主参考附件。。。

厉害!
晚上好, 感谢老师…

On_fire

gwjkkkkk 发表于 2022-12-23 19:00
Sub TEST()
    Dim arr, vData, i&, j&, iNum&, Rng As Range
   

老师早上好,
请问如果那个X及Y轴的”行列”是个变量,
不是跟判断区域的资料连在一起 ( 如截图标黄 ),
请问要怎么改呢?

gwjkkkkk

具体要看表格情况，设置变量有些难度。。。

On_fire

gwjkkkkk 发表于 2022-12-28 11:05
具体要看表格情况，设置变量有些难度。。。

老师好,

请看文件Sheet1

Range(“E71:P82”)是要判断的区域,

B71~B82是Y轴值, E87~P87是X轴值,

请问要如何优化?

gwjkkkkk

请楼主参考附件。。。

On_fire

gwjkkkkk 发表于 2022-12-28 11:56
请楼主参考附件。。。

再次感谢老师…