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

Question

我目前正在使用Excel中的金融数据中的VBA。

基本上我想要做的是在D＆＃34;汽车＆＃34;列中找到一个值。对于所有出现的＆＃34; Automotive＆＃34;。

，然后在G列中找到相应的值

一旦我拥有了所有的价值（并且有很多），我会找到＆＃34; Automotive＆＃34;列H中的相应值。我将要找到的所有值然后我们将对它们执行SUMPRODUCT。

所以它看起来像这样

list:[T](p:T)List[T]

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

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

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

X

Y 

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

Z

B

Answer 1

通过这样的问题，通常最好披露您计划对结果做些什么。最好的攻击计划通常取决于结果的使用位置和方式。

我将假设一个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

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

Answer 2

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

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

首先，假设您有对工作表的引用。我们在这里称之为Sht。此外，此示例对每个循环使用，但 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