在dynamic范围VBA中从0find最远的数字

我有一个Excel工作簿，其中最多有6个数据集，但数据集内的数据长度或数量是可变的/dynamic的。 我希望能够在所有的A-Axis_Disp列中find从0开始的最远的值（见下图）。 我想我的代码是正确的，但不知道如何完成。 任何提示/帮助将不胜感激。 TIA。

这是我的代码：

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 

Answer 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)))) 

Answer 2

我不确定这是你以后的样子

无码：

 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 

Answer 3

这是我第一篇文章的重写

它会查找所有A-Axis_Disp列，直到列ZZ（可以更改）

我离开debugging线的代码（目前已注释掉…如果你喜欢删除它们）

 Sub minMax() Dim aaa As Range Dim min As Long Dim max As Long Dim colm As Long Dim colOffset As Long Dim searchRange As String ' this is plugged into application.evaluate argument colm = Application.Evaluate("=IFNA(MATCH(""A-Axis_Disp"",1:1,0),0)") ' find first column If colm > 0 Then Set aAxisData = Sheets("Sheet1").Columns(colm) ' aAxisData.Select ' for debugging only Else Exit Sub ' exit if no column found. something more can be put here End If ' Debug.Print Split(Sheets("sheet1").Range("zz4").Address(1, 0), "$")(0) ' debug only ' Debug.Print Split(Sheets("sheet1").Cells(1, colm + 1).Address(1, 0), "$")(0) ' debug only Do While True searchRange = Split(Sheets("sheet1").Cells(1, colm + 1).Address(1, 0), "$")(0) & "1:ZZ1" ' Debug.Print searchRange ' for debugging only colOffset = Application.Evaluate("=IFNA(MATCH(""A-Axis_Disp""," & searchRange & ",0),0)") If colOffset = 0 Then Exit Do colm = colm + colOffset ' Sheets("Sheet1").Columns(colm).Select ' for debugging only Set aAxisData = Union(aAxisData, Sheets("Sheet1").Columns(colm)) Loop ' aAxisData.Select ' for debugging only min = Application.WorksheetFunction.min(aAxisData) max = Application.WorksheetFunction.max(aAxisData) If Abs(min) > max Then Debug.Print "extreme is "; min ElseIf Abs(min) < max Then Debug.Print "extreme is "; max Else Debug.Print "extremes are "; min; " and "; max End If End Sub