在動態範圍內從0找到最大數字VBA

我有一個excel工作簿，其中最多有6個數據集，但數據集中的數據長度或數量是可變/動態的。我希望能夠在所有的A-Axis_Disp列中找到從0開始的最遠的值（見下圖）。我認爲我的代碼是正確的，但不知道如何完成它。任何提示/幫助將不勝感激。 TIA。在動態範圍內從0找到最大數字VBA

這裏是我的代碼：

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

來源

2017-08-10 hdk857

我熱烈推薦你學會正確地縮進代碼，或[使用一個工具，它會爲你（http://rubberduckvba.com/indentation） - 將來你應該心存感激！ –

固定縮進。我還添加了一個缺少的「End If」，假設它的位置 - 如果這是錯誤的話，可以自由修復。 –

會公式足夠了？

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

來源

2017-08-10 18:35:34 Jeeped

我想編輯說「會*一個簡單的*公式就夠了」，但是...... ;-) –

我想我的工作表是乾淨的，我也有一個動態範圍，所以我想我會不得不使用vba？如我錯了請糾正我。 – hdk857

我不知道這是否是你是什麼

後無代碼：

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

來源

2017-08-10 18:45:00 jsotola

聰明的回答。該公式工作得很好，唯一的問題是硬編碼範圍（設置公式，然後在「B」之前添加一列）。該公式可以設置爲正確更新，但您的代碼不能。另外值得注意的是，它只顯示最大/最小值（這是OP所要求的），但如果他的下一步是以某種方式使用單元格......那麼將需要一些全新的東西。 –

這裏是一個重寫o ˚F我第一次發佈

它看起來對所有A-Axis_Disp列高達ZZ列（這是可以改變的）

我離開的代碼（目前註釋掉調試線...如果你喜歡它們刪除）

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

來源

2017-08-10 23:00:53 jsotola

在動態範圍內從0找到最大數字VBA

回答

相關問題