Question

Hello stackoverflow社区，

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

我目前的目标是这样，我有一个“费用报告”通过扣除发送给我，此报告有许多列，可以填充或可能为空的不同帐户名。

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

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

我非常感谢任何可能指向我的目标的反馈，解释或链接。提前感谢您花时间阅读此内容！

目前的代码状态：

`< 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

MS Excel VBA - 循环遍历列和行

1 个答案: