遍历行并分离出每个“访问”答案

【问题标题】：Loop through rows and seperate out each "visit"遍历行并分离出每个“访问”
【发布时间】：2014-11-21 19:12:07
【问题描述】：

我有一个表格，其中包含访问、已完成的应用程序和批准，每行作为邮政编码，我正在尝试将表格转换为每行是访问的表格。由于我在 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 个批准。知道这是为什么吗？

【问题讨论】：

申请或批准的数量是否会超过访问次数？这是差异的一种解释
@DyRuss 确实如此，已完成的应用程序比访问次数多 39 倍，非常感谢您的帮助
@Mike 在下面查看我的代码以回答...

标签： vba excel

【解决方案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

【讨论】：