Question

我有一个包含Visits，Completed Applications和Approvals的表格，每行都是一个邮政编码，我试图将表格变成一个表格，其中每一行都是一个访问。由于我在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

循环遍历行并将每个＆＃34;访问分开＃34;

1 个答案: