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

Question

我有一张表，其中包含访问、已完成的应用程序和批准，每行作为邮政编码，我试图将表转换为每行是访问的表。由于我在 Excel 中，我试图在 VBA 中编写一个宏来执行此操作，但这给了我一些不准确的地方。这是我的 table :

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