循环行并分离出每个“访问”

我有一个与访问,完成的应用程序,并与每行作为一个邮政编码的批准表,我试图把表变成一个表,其中每一行是一个访问。 由于我在Excel中,我正尝试在VBA中编写一个macros来执行此操作,但是这给我带来了一些不准确的地方。 这是我的桌子:

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 

这是我的macros:

 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个批准,但是当我运行我的macros时,我得到4244次访问,770个已完成申请和55个批准。 任何想法,为什么这是?

编辑:这段代码find每次访问的平均值(以及其余部分),并按照您的示例均匀分配到单元格中。 testing工作!

 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