MAXIF用のVBAコードを作成する

Question

別の投稿のコードを理解しやすくなるように修正しました。コードを実行するとき、私はまだこの行のために "タイプ不一致"というエラーを受け取ります：w(k) = z(i, 1)。誰もがこのエラーの洞察を持っていますか？

マイコードあなたはMaxRange範囲の間で選択するために、いくつかのうちの最大値を返すに興味があるので、

Option Base 1 

Function MaxIf(MaxRange As Range, Lookup_Range1 As Range, Var_Range1 As Variant, _ 
       Lookup_Range2 As Range, Var_Range2 As Variant) As Variant 

    Dim x() As Variant, y() As Variant, z() As Variant, w() As Long 
    Dim i As Long 
    Dim Constraint1 As Variant, Constraint2 As Variant, k As Long 

    i = 1 
    k = 0 
    Constraint1 = Var_Range1 
    Constraint2 = Var_Range2 
    x = Lookup_Range1 
    y = Lookup_Range2 
    z = MaxRange 

    For i = 1 To Lookup_Range1.Rows.Count 
     If x(i, 1) = Var_Range1 Then 
      If y(i, 1) = Var_Range2 Then 
       k = k + 1 
       ReDim Preserve w(k) 
       w(k) = z(i, 1) 
      End If 
     End If 
    Next i 
    MaxIf = Application.Max(w) 

End Function    

Answer 1

、その後、あなただけの数値値をループし、対応するの状況を確認することができLookup_Range1のみLookup_Range2の細胞、次のように：

Function MaxIF(MaxRange As Range, Lookup_Range1 As Range, Var_Range1 As Variant, _ 
       Lookup_Range2 As Range, Var_Range2 As Variant) As Variant 

    Dim LU1 As Variant, LU2 As Variant 
    Dim founds As Long 
    Dim cell As Range 

    LU1 = Lookup_Range1.Value2 '<--| store Lookup_Range1 values 
    LU2 = Lookup_Range2.Value2 '<--| store Lookup_Range2 values 

    ReDim ValuesForMax(1 To MaxRange.Rows.count) As Long '<--| initialize ValuesForMax to its maximum possible size 
    For Each cell In MaxRange.Columns(1).SpecialCells(xlCellTypeConstants, xlNumbers) 
     If LU1(cell.row, 1) = Var_Range1 Then '<--| check 'Lookup_Range1' value in corresponding row of current 'MaxRange' cell 
      If LU2(cell.row, 1) = Var_Range2 Then '<--| check 'Lookup_Range2' value in corresponding row of current 'MaxRange' cell 
       founds = founds + 1 
       ValuesForMax(founds) = CLng(cell) '<--| store current 'MaxRange' cell 
      End If 
     End If 
    Next cell 
    ReDim Preserve ValuesForMax(1 To founds) '<--| resize ValuesForMax to its actual values number 
    MaxIF = Application.max(ValuesForMax) 
End Function 

Iも変数に意味のある名前を与えました

Answer 2

コードを実行すると、2つの条件に制限されていました。 MaxIfs関数の条件数を制限しないために、このコードをさらに使うことにしました。以下のコードを参照してください：

Function MaxIfs(MaxRange As Range, ParamArray Criteria() As Variant) As Variant 
    Dim n As Long 
    Dim i As Long 
    Dim c As Long 
    Dim f As Boolean 
    Dim w() As Long 
    Dim k As Long 
    Dim z As Variant 

    'Error if less than 1 criteria 
    On Error GoTo ErrHandler 
    n = UBound(Criteria) 
    If n < 1 Then 
     'too few criteria 
     GoTo ErrHandler 
    End If 

    'Define k 
    k = 0 

    'Loop through cells of max range 
    For i = 1 To MaxRange.Count 

    'Start by assuming there is a match 
    f = True 

     'Loop through conditions 
     For c = 0 To n - 1 Step 2 

      'Does cell in criteria range match condition? 
      If Criteria(c).Cells(i).Value <> Criteria(c + 1) Then 
       f = False 
      End If 

     Next c 

     'Define z 
     z = MaxRange 

     'Were all criteria satisfied? 
     If f Then 
      k = k + 1 
      ReDim Preserve w(k) 
      w(k) = z(i, 1) 
     End If 

    Next i 

    MaxIfs = Application.Max(w) 

    Exit Function 
    ErrHandler: 
    MaxIfs = CVErr(xlErrValue) 

End Function 

このコードでは、複数の条件が可能です。

このコードは、Eileen's LoungeでHans Vが投稿した複数のコードを参照して開発されたものです。

Diedrich