Excel VBA: Untuk Setiap pengaturan loop

Ini mungkin bukan jawaban yang Anda cari, tapi menurut saya inilah cara saya mendekati proyek Anda. Akan sangat membantu jika Anda melihat data mentah yang Anda dapatkan di laporan dan menempelkannya ke dalam spreadsheet.

Dua asumsi pertama (dan Anda tahu apa yang mereka katakan tentang asumsi)

1. Data diambil dari database dan dikembalikan sebagai baris yang mungkin tidak berurutan. Misalnya:

 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 

2. Anda ingin semua produk asuransi dijumlahkan untuk setiap kantor dan kemudian ditampilkan dalam format laporan yang lebih cantik.

If these assumptions are true (or close to true), you could create a HomeOffice class that had a property for each type of insurance, then simply loop through the rows of data in the raw report and add each HomeOffice object to a collection so you get a unique list of offices.

Contoh dari proyek serupa yang saya lakukan:

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

Untuk melakukan ini, tambahkan modul Kelas (Sisipkan -> Modul Kelas) dan ubah namanya menjadi HomeOffice. Masukkan kode ini ke dalam kelas (beberapa bagian dilewati agar tidak terlalu panjang. Isi jika diperlukan untuk menambahkan properti untuk setiap produk asuransi.)

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

Sekarang di sub CommandButton23_Click Anda tambahkan kode ini (sekali lagi disingkat agar singkatnya, tapi semoga Anda mendapatkan gambarannya.):

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

Ini adalah pendekatan yang sangat berbeda, dan melibatkan beberapa konsep yang lebih ketat. Seperti yang saya katakan, ini mungkin tidak berfungsi tergantung pada bagaimana data mentah diformat, tapi mungkin ini bisa memberi Anda cara berbeda untuk mengatasi masalah Anda.