如何找到多个值、存储它们，然后在 VBA 中操作它们？

Question

我目前在财务数据的 Excel 中使用 VBA。

基本上我想要做的是在 D 列“汽车”中找到一个值，然后在 G 列中找到所有出现的“汽车”的相应值。

一旦我拥有了所有值（并且有很多），我将在 H 列中找到“汽车”和相应的值。我将找到的所有值然后对它们执行 SUMPRODUCT。

所以它看起来像这样

Automotive       9.121..........................4.6 

X

Y 

Automotive       4.8............................2.2 

Z

B

我会将 9.121,4.8 存储在一个数组中（比如 Auto），将 4.6,2.2 存储在另一个数组中。

然后程序将对所有不同的值执行 sumproduct

(9.121 x 4.6) +

(4.6 x 2.2) +
...... etc.

Answer 1

您可能已经知道这不必在 VBA 中完成。 Excel 可以通过其功能处理分析。但是，如果您要编写一个脚本来首先获取产品然后获取总计，那么有几种方法可以做到这一点。这是一个。

循环遍历范围，并保持运行总和。

首先，假设您引用了工作表。我们在这里称它为Sht。此外，此示例使用 for each 循环，但 for 循环可能更好（要求您计算第一列中的行数）。

Sub AutoProdSum()

    Dim AutoR as Excel.Range
    Dim ColG as Excel.Range
    Dim ColH as Excel.Range

    Set AutoR = Sht.Range("$D:$D")
    Set ColG = Sht.Range("$G:$G")
    Set ColH = Sht.Range("$H:$H")

    Dim ThisAuto as Excel.Range
    Dim Var as Variant
    Dim ThisG as Excel.Range
    Dim valG as Double
    Dim ThisH as Excel.Range
    Dim valH as Double
    Dim prod as Double
      prod = 0
    Dim total as Double
      total = 0

    For Each Var in AutoR
      Set ThisAuto = AutoR.Find("Automotive",SearchBy:=xlValues)
      If ThisAuto.Value = "Automotive" Then
        Set ThisG = ThisAuto.Offset(0,3)
        Set ThisH = ThisAuto.Offset(0,4)
        valG = ThisG.Value
        valH = ThisG.Value
        prod = valG * valH
        total = total + prod

      End If
    Next

    MsgBox "The grand total is " & total
    'Or you can insert the total into the spreadsheet.

End Sub

Answer 2

对于这样的问题，通常最好披露您打算如何处理结果。最佳的攻击计划通常取决于结果的使用地点和方式。

我将假设一个 VBA 函数将返回一个 double，即您正在寻找的结果就足够了。下面是几个例子。

Function byProductAutomotiveA(rngA As Range, crt As String, rng1 As Range, rng2 As Range)
    Dim frmla As String

    'like =SUMPRODUCT((B2:B10="Automotive")*(D2:D10)*(G2:G10))
    frmla = "=SUMPRODUCT((" & rngA.Address(external:=True) & "=""" & crt & """)*" & _
                        "(" & rng1.Address(external:=True) & ")*" & _
                        "(" & rng2.Address(external:=True) & "))"
                        'D2:D10)*(G2:G10))
    'Debug.Print frmla
    byProductAutomotiveA = Application.Evaluate(frmla)

End Function

Function byProductAutomotiveB(rngA As Range, crt As String, rng1 As Range, rng2 As Range)
    Dim rng As Range, rslt As Double

    For Each rng In rngA
        If LCase(rng.Value2) = "automotive" Then
            rslt = rslt + (rng.Offset(0, rng1.Column - rng.Column).Value2 * rng.Offset(0, rng2.Column - rng.Column).Value2)
        End If
    Next rng

    byProductAutomotiveB = rslt

End Function

Sub byProductAutomotive()
    Dim rw As Long, rslt As Double

    With Worksheets("Automotive")
        For rw = 2 To .Cells(Rows.Count, 4).End(xlUp).Row
            If LCase(.Cells(rw, 4).Value2) = "automotive" Then
                rslt = rslt + (.Cells(rw, 7).Value2 * .Cells(rw, 8).Value2)
            End If
        Next rw
        .Cells(13, 10) = rslt
    End With

End Sub

以下专门丢弃隐藏的行。

Function byProductAutomotiveBH(rngA As Range, crt As String, rng1 As Range, rng2 As Range)
    Dim rng As Range, rslt As Double

    On Error Resume Next

    For Each rng In rngA
        If LCase(rng.Value2) = LCase(crt) And Not rngA.Parent.Rows(rng.Row).Hidden Then
            rslt = rslt + (rng.Offset(0, rng1.Column - rng.Column).Value2 * rng.Offset(0, rng2.Column - rng.Column).Value2)
        End If
    Next rng

    byProductAutomotiveBH = rslt

End Function

这些函数也可用于将结果检索回另一个 sub 中的 var。小心让任何Range object 正确。