MS Excel VBA - 循环遍历列和行

Question

你好 stackoverflow 社区，

我必须承认我主要在 MS Access 中编写代码，并且对 MS Excel VBA 的经验非常有限。

我目前的目标是，我收到了一份带有扣除额的“费用报告”，该报告有许多不同帐户名称的列，这些列可能已填充或可能为空。

我的第一步是从第一条记录（第 14 行；A-K 列包含有关扣除的个人信息）开始，然后跳到第一个扣除账户（扣除账户从 L 列开始，跨越到 DG 列）检查是否每个单元格为空，如果它继续向右移动，如果存在值，我需要将其复制到从第 2 行开始的外部工作簿“工资单模板”（扣除本身的 J 列），以及复制一些与该扣除相关的“费用报告”中原始行中的个人信息（currRow：从“费用报告”到“工资单模板”列 B、C、D 的 C、E、F 列）。

然后向右移动直到下一个单元格包含一个值，然后在“工资单模板”中的新行上重复此过程。执行完最后一列 (DG) 后，我想移动到下一行（第 15 行）并再次开始该过程，直到“使用范围”中的“最后一行”。

我非常感谢任何可能指向我的目标的反馈、解释或链接。提前感谢您抽出宝贵时间阅读本文！

当前代码状态：

`< Sub LoadIntoPayrollTemplate()
Dim rng As Range
Dim currRow As Integer
Dim UsedRng As Range
Dim LastRow As Long



Set UsedRng = ActiveSheet.UsedRange
currRow = 14


Set wb = ActiveWorkbook '"Expense Report"
Set wb2 = MyFilepath '"Payroll Template"


'Copied from another procedure, trying to use as reference         
LastRow = rng(rng.Cells.Count).Row
Range("A14").Select
Do Until ActiveCell.Row = LastRow + 1
    If (ActiveCell.Value) <> prev Then

        currRow = currRow + 1

    End If

    ActiveCell.Offset(1, 0).Select
Loop

With Worksheets("Collections")
    lstRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set rng = .Range(.Cells(14, 12), Cells(lstRow, 111))
End With

End Sub>`

Answer 1

以下代码可能会满足您的需求：

Sub LoadIntoPayrollTemplate()
    Dim currRowIn As Long
    Dim currColIn As Long
    Dim currRowOut As Long
    Dim wb As Workbook
    Dim wb2 As Workbook

    Set wb = ActiveWorkbook '"Expense Report"
    Set wb2 = Workbooks.Open(Filename:=MyFilepath & "\" & "Payroll Template.xlsx")
    'or perhaps
    'Set wb2 = Workbooks.Open(Filename:=wb.path & "\" & "Payroll Template.xlsx")

    With wb.ActiveSheet
        currRowOut = 1
        For currRowIn = 14 To .UsedRange.Row + .UsedRange.Rows.Count - 1
            For currColIn = 12 To 111
                If Not IsEmpty(.Cells(currRowIn, currColIn)) Then
                    currRowOut = currRowOut + 1
                    'I'm not sure which worksheet you want to write the output to
                    'so I have just written it to the first one in Payroll Template
                    wb2.Worksheets(1).Cells(currRowOut, "J").Value = .Cells(currRowIn, currColIn).Value
                    wb2.Worksheets(1).Cells(currRowOut, "B").Value = .Cells(currRowIn, "C").Value
                    wb2.Worksheets(1).Cells(currRowOut, "C").Value = .Cells(currRowIn, "E").Value
                    wb2.Worksheets(1).Cells(currRowOut, "D").Value = .Cells(currRowIn, "F").Value

                End If
            Next
        Next
    End With

    'Save updated Payroll Template
    wb2.Save

End Sub