Excel VBA：对于每个循环设置

Question

编辑：在下面添加了原始数据示例

我每个月都会生成一份索赔报告，并将数据复制到一个标签中。所有的数据都被组织成列，我一直在使用一个充满SumProduct和CountIf的电子表格来根据不同的标准集来计算和组织数据，但是处理时间太长了我正在尝试编写一个 VBA 子程序来更有效地完成此任务。其中一列数据是“Adjuster Home Office”。此列基本上是每个索赔起源的办公室列表。我使用AdvancedFilter 提取此列中的所有唯一值并将它们复制到 A 列中的单独选项卡中。然后，在 C 列中，在每个位置下方，我有一个声明类型列表或处理的“行项目”在每个办公室。设置这部分我没有问题。在 D 列中，我需要能够在该指定位置显示每个行项目的计数。这就是所有Countif 和SumProduct 在我一直使用的旧模板中发挥作用的地方。这是我遇到障碍的地方。我正在尝试使用 For Each 循环来计算第一个位置下方 B 列中的每个行项目，然后移动到 A 列中的下一个位置并重复。以下是我尝试过的代码：

Private Sub CommandButton23_Click()

Dim linerngs As Range
Dim lineitem As Range
Dim lastlinerow As Long
Dim wsf
Dim TabLastRow
Dim claimstab As String
Dim officesrange As Range
Dim office As Range

claimstab = Sheet2.Range("F2") & " Claims"

TabLastRow = Sheets(claimstab).Cells(Sheets(claimstab).Rows.Count, "A").End(xlUp).Row

Set wsf = Application.WorksheetFunction

officeslastrow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
lastlinerow = Sheet2.Range("C" & Rows.Count).End(xlUp).Row

Set officerng = Range("A6:A" & officeslastrow).SpecialCells(xlCellTypeConstants, 23)
Set linerngs = Range("C7:C" & lastlinerow).SpecialCells(xlCellTypeConstants, 23)

For Each office In officerng
    For Each lineitem In linerngs
        If InStr(1, lineitem.Value, "IN") > 0 And InStr(1, lineitem.Value, "AOS") = 0 Then
            lineitem.Offset(0, 3) = Application.WorksheetFunction.SumProduct(wsf.CountIfs(Sheets(claimstab).Range("B2:B" & TabLastRow), office))
        End If
    Next lineitem
Next office


End Sub

我知道这是不正确的，因为这些循环将遍历 B 列中的所有内容，而不仅仅是每个位置下方的行项目。所以我最终得到的是整个列中每个行项目显示的最后一个位置的计数。下面是我需要它的样子的一个例子。现在，我所关心的只是设置循环以正确运行。

我目前得到的示例 [

我想要得到的例子 [

您可以从第一个示例中看到，我得到了所有内容的值“3”。我包括了位置和它们的值的一个支点。您可以看到枢轴中的最后一个位置南波特兰的计数为 3。

任何帮助将不胜感激。

原始数据示例 [

目标 [

[ 订单项列表由要求用户输入的用户表单创建完成

Answer 1

这可能不是您正在寻找的答案，但我认为这就是我处理您的项目的方式。查看您在报告中获得的原始数据并将其粘贴到电子表格中会很有帮助。

前两个假设（你知道他们对假设的看法）

1. 正在从数据库中提取数据并作为可能不按顺序排列的行返回。例如：

 ATLANTA, GA     IN-AK, HI  3  IN-CA  2  ...  IncidentOnly  4
 BOCA RATON, FL  IN-AK, HI  3  IN-CA  6  ...  IncidentOnly  5 
 ATLANTA, GA     IN-AK, HI  1  IN-CA  0  ...  IncidentOnly  2 
 ...
 AURORA, IL      IN-AK, HI  7  IN-CA  3  ...  IncidentOnly  4 

1. 您希望汇总每个办事处的所有保险产品，然后以更漂亮的报告格式显示。

如果这些假设正确（或接近正确），您可以创建一个 HomeOffice 类，该类具有每种保险类型的属性，然后简单地遍历原始报告中的数据行并将每个 HomeOffice 对象添加到集合，以便您获得唯一的办公室列表。

我做过的一个类似的探测项目的例子：

Raw Data:
Mary    2   6
Sally   4   9
Mary    4   1
Sally   3   8
Joe     1   4
Bob     3   7
Mary    6   9
Sally   8   4
Bob     4   8
Joe     2   6
Joe     4   5

Formatted Data:
Mary       12      16
Sally      15      21
Bob         7      15
Joe         7      15

为此，添加一个类模块（插入 -> 类模块）并将其名称更改为 HomeOffice。将此代码插入到类中（跳过了一些位，所以它不会那么长。填写需要为每个保险产品添加属性的地方。）

Option Explicit

Private pOffice As String
Private pINAKI As Double
Private pINCA As Double
'... class properties left out for brevity
Private pIncidentOnly As Double


''''''''''''''''''''''
' Office property
''''''''''''''''''''''
Public Property Get Office() As String
    Office = pOffice
End Property
Public Property Let Office(Value As String)
    pOffice = Value
End Property

''''''''''''''''''''''
' INAKI property
''''''''''''''''''''''
Public Property Get INAKI() As Double
    INAKI = pINAKI
End Property
Public Property Let INAKI(Value As Double)
    pINAKI = Value
End Property

''''''''''''''''''''''
' INCA property
''''''''''''''''''''''
Public Property Get INCA() As Double
    INCA = pINCA
End Property
Public Property Let INCA(Value As Double)
    pINCA = Value
End Property

''''''''''''''''''''''
' Add other propertied for the different product types
''''''''''''''''''''''
' Follow the same format as the other properties

''''''''''''''''''''''
' IncidentOnly property
''''''''''''''''''''''
Public Property Get IncidentOnly() As Double
    IncidentOnly = pIncidentOnly
End Property
Public Property Let IncidentOnly(Value As Double)
    pIncidentOnly = Value
End Property

现在在您的 CommandButton23_Click 子中添加此代码（为简洁起见再次缩短，但希望您能得到图片。）：

Sub test()
    Dim col As Collection
    Dim r As Integer
    Dim c As Integer
    Dim HO As New HomeOffice

    'Collections can only have one Item, Key pair. 
    'We'll use the office location as the key to get a 
    'unique list of offices
    Set col = New Collection

    'Read in the raw data
    With Sheet1
        For r = 1 To .UsedRange.Rows.Count
            'Check if the location has an existing HomeOffice object 
            If InCol(col, .Cells(r, 1)) Then
                'It does so get the existing object and total the values
                Set HO = col.Item(.Cells(r, 1))
                HO.Office = .Cells(r, 1)
                HO.INAKI = HO.INAKI + .Cells(r, 2)
                HO.INCA = HO.INCA + .Cells(r, 3)
                ' more properties
                HO.IncidentOnly = HO.IncidentOnly + .Cells(r, 10)
                'We have to remove the existing object and add it again
                'to reflect the updated totals
                col.Remove (.Cells(r, 1))
            Else
                'The location hasn't been added yet so create and add it
                HO.Office = .Cells(r, 1)
                HO.INAKI = .Cells(r, 2)
                HO.INCA = .Cells(r, 3)
                ' More properties
                HO.IncidentOnly = .Cells(r, 10)
            End If
            col.Add HO, .Cells(r, 1)
            'Important to clear our object or our totals are wrong! :)
            Set HO = Nothing
        Next r
    End With

    'Now we simply loop through our collection of offices and
    'print out the totals.
    r = 6 'The first office starts on row 6 in your picture
    With Sheet2
        For Each HO In col
            .Cells(r, "A").Value = HO.Office
            .Cells(r + 1, "C").Value = "IN - AK, HI"
            .Cells(r + 1, "F").Value = HO.INAKI
            .Cells(r + 2, "C").Value = "IN - CA"
            .Cells(r + 2, "F").Value = HO.INCA
            'Continuing on for all 10 types
            .Cells(r + 10, "C").Value = "Incident Only"
            .Cells(r + 10, "F").Value = HO.IncidentOnly
            Set HO = Nothing
            r = r + 13 'So the next office starts 13 rows later...Row 19 in your pic
        Next
    End With
End Sub

Function InCol(col As Collection, key As Variant) As Boolean
    'Returns TRUE if the object is in the collection or FALSE if it is not
    Dim obj As New HomeOffice

    On Error GoTo err
    InCol = True
    'If the key doesn't exist, it throws an error and set the function to false
    Set obj = col(key)
    Set obj = Nothing
    Exit Function

err:
        InCol = False
End Function

这是一种截然不同的方法，涉及一些更严格的概念。就像我说的那样，它可能无法正常工作，具体取决于原始数据的格式，但也许它可以为您提供解决问题的不同方法。