在动态范围VBA中找到0的最远数字

时间:2017-08-10 18:03:46

标签: excel vba excel-vba

我有一个excel工作簿,其中最多有6个数据集,但数据集中的数据长度或数量是可变/动态的。我希望能够在所有A-Axis_Disp列中找到0的最远值(见下图)。我想我的代码是正确的,但不知道如何完成它。任何提示/帮助将不胜感激。 TIA。 enter image description here

这是我的代码:

Sub FindFurthestNoFromZero()
    Dim iRng As Range
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim Rng3 As Range
    Dim NewRng1 As Range
    Dim val As Variant
    Dim B As Integer
    Dim Dispws As Worksheet

    Set Dispws = Sheets("Disp_&_Result_Calc")

    Set iRng = Dispws.Range(Dispws.Cells(1, 1), Dispws.Cells(1, Dispws.Cells(1, Columns.Count).End(xlToLeft).column))

    B = 0
    Do Until B = Sheets("Hidden").Range("G2").Value + 1

        For Each cel In iRng
            If cel.Value = "A-Axis_Disp" Then
                Set Rng1 = cel.EntireColumn.Find(What:="", LookIn:=xlValues, LookAt:=xlPart)
                Debug.Print Rng1.FormulaR1C1
                Set Rng2 = Dispws.Cells(Rng1.row - 1, Rng1.column)
                Debug.Print Rng2.FormulaR1C1
                Set Rng3 = Cells(cel.row + 1, cel.column)
                Debug.Print Rng3.FormulaR1C1

                Set NewRng1 = Range(Rng3.Address & ":" & Rng2.Address)
                Debug.Print NewRng1.Address

                For Each cell In Range("NewRng1")
                    val = cell.Value
                Next cell
            End If
        Next cel
    Loop

End Sub

3 个答案:

答案 0 :(得分:1)

公式是否足够?

=IFERROR(INDEX(C:C, IFERROR(MATCH(MAX(AGGREGATE(14,6,ABS(0-C2:INDEX(C:C,MATCH(E1+99,C:C))),1),AGGREGATE(14,6,ABS(0-H2:INDEX(H:H,MATCH(E1+99,H:H))),1)), C:C, 0),
                            MATCH(0-MAX(AGGREGATE(14,6,ABS(0-C2:INDEX(C:C,MATCH(E1+99,C:C))),1),AGGREGATE(14,6,ABS(0-H2:INDEX(H:H,MATCH(E1+99,H:H))),1)), C:C,0))),
        INDEX(H:H, IFERROR(MATCH(MAX(AGGREGATE(14,6,ABS(0-C2:INDEX(C:C,MATCH(E1+99,C:C))),1),AGGREGATE(14,6,ABS(0-H2:INDEX(H:H,MATCH(E1+99,H:H))),1)), H:H, 0),
                           MATCH(0-MAX(AGGREGATE(14,6,ABS(0-C2:INDEX(C:C,MATCH(E1+99,C:C))),1),AGGREGATE(14,6,ABS(0-H2:INDEX(H:H,MATCH(E1+99,H:H))),1)), H:H,0))))

enter image description here

答案 1 :(得分:1)

我不确定这是不是你的目标

没有代码:

cell AF1:  =MIN(C:C,H:H,M:M,R:R,W:W,AB:AB)
cell AF2:  =MAX(C:C,H:H,M:M,R:R,W:W,AB:AB)
cell AF3:  =IF(ABS(AF1)>AF2,AF1,AF2)              this is your answer

VBA代码:

Sub minMax()

    Dim min As Long
    Dim max As Long

    min = Application.WorksheetFunction.min(Sheets("Sheet1").Range("C:C,H:H,M:M,R:R,W:W,AB:AB"))
    max = Application.WorksheetFunction.max(Sheets("Sheet1").Range("C:C,H:H,M:M,R:R,W:W,AB:AB"))

    If Abs(min) > max Then
        Debug.Print "extreme at "; min
    ElseIf Abs(min) < max Then
        Debug.Print "extreme at "; max
    Else
        Debug.Print "extremes at "; min; " and "; max
    End If
End Sub

答案 2 :(得分:0)

这是我第一次发布的重写

它查找ZZ列之前的所有A-Axis_Disp列(可以更改)

我在代码中留下了调试行(目前已注释掉......如果你愿意,可以删除它们)

AlternateView