vba - 循环遍历行并分离出每一行 "visit"

Question

我有一个包含访问、已完成的申请和批准的表，每行都是邮政编码，我正在尝试将该表转换为每行都是一次访问的表。由于我使用的是 Excel，因此我尝试在 VBA 中编写一个宏来执行此操作，但它给我带来了轻微的不准确性。这是我的表格:

Zip     Visits Applications   Approvals
75229   3      2              1

                |
                |
                v

Zip     Visits          Applications    Approvals
75229   1               0               0
75229   1               1               0
75229   1               1               1

这是我的宏:

Sub TestMacro1()

Dim n As Integer
Dim i As Integer
Dim StartCell As Range
Dim PrintCell As Range


For n = 0 To 5000
    Set StartCell = Range("A2").Offset(n, 0)
    Set PrintCell = Range("F10000").End(xlUp)



    For i = 1 To StartCell.Offset(0, 1).Value
        PrintCell.Offset(i, 0) = StartCell.Value
        PrintCell.Offset(i, 1) = 1

        If i <= StartCell.Offset(0, 2).Value Then
             PrintCell.Offset(i, 2) = 1
        Else
            PrintCell.Offset(i, 2) = 0
        End If
        If i <= StartCell.Offset(0, 3).Value Then
            PrintCell.Offset(i, 3) = 1
        Else
            PrintCell.Offset(i, 3) = 0
        End If


    Next i

Next n

End Sub

总共有 4244 次访问、3508 行、815 个已完成的申请和 58 个批准，但当我运行宏时，我得到 4244 次访问、770 个已完成的申请和 55 个批准。知道这是为什么吗？

Answer 1

要求您必须有工作表(您可以将它们命名为任何您想要的名称并相应地修复代码)编辑:此代码查找每次访问的平均值(以及此后的其余部分)并将它们均匀地分布在每个示例的单元格中。测试工作正常!

Sub TestMacro1()

Dim LastRow As Long
Dim CurRow As Long
Dim DestRow As Long
Dim ChkRow As Long
Dim CurWS As Worksheet
Dim DestWS As Worksheet
Dim Visits As Integer
Dim Apps As Integer
Dim Approvals As Integer
Dim AvgApps As Integer
Dim AvgApprovals As Integer
Dim Zip As String
Dim AppsRemain As Integer
Dim ApprovalsRemain As Integer

Set CurWS = ActiveWorkbook.Sheets("Test")
Set DestWS = ActiveWorkbook.Sheets("DestTest")

LastRow = CurWS.Range("A" & CurWS.Rows.Count).End(xlUp).Row

For CurRow = 2 To LastRow
    Zip = CurWS.Cells(CurRow, 1).Value 'Assumes Zip is in Column A (1)
    Visits = CurWS.Cells(CurRow, 2).Value 'Assumes Visits is in Col B (2)
    Apps = CurWS.Cells(CurRow, 3).Value 'Assumes Apps is in Col C (3)
    Approvals = CurWS.Cells(CurRow, 4).Value 'Assumes Approvals is in Col D (4)
    AvgApps = Apps \ Visits
    AvgApprovals = Approvals \ Visits
    AppsRemain = Apps Mod Visits
    ApprovalsRemain = Approvals Mod Visits
        DestRow = DestWS.Range("A" & DestWS.Rows.Count).End(xlUp).Row + 1
        For ChkRow = Visits To 1 Step -1
            DestWS.Cells(DestRow + ChkRow - 1, 1).Value = Zip 'Assumes Zip is in Column A (1)
            DestWS.Cells(DestRow + ChkRow - 1, 2).Value = 1 'Assumes Visits is in Col B (2)
            If AppsRemain > 0 Then
                DestWS.Cells(DestRow + ChkRow - 1, 3).Value = AvgApps + 1 'Assumes Apps is in Col C (3)
                AppsRemain = AppsRemain - 1
                Else
                DestWS.Cells(DestRow + ChkRow - 1, 3).Value = AvgApps 'Assumes Apps is in Col C (3)
            End If
            If ApprovalsRemain > 0 Then
                DestWS.Cells(DestRow + ChkRow - 1, 4).Value = AvgApprovals + 1 'Assumes Approvals is in Col D (4)
                ApprovalsRemain = ApprovalsRemain - 1
                Else
                DestWS.Cells(DestRow + ChkRow - 1, 4).Value = AvgApprovals 'Assumes Approvals is in Col D (4)
            End If
        Next ChkRow
Next CurRow

End Sub