MS Excel VBA — перебор столбцов и строк

#vba #excel #loops #offset

#vba #excel #циклы #смещение

Вопрос:

Привет сообществу stackoverflow,

Должен признаться, я в основном пишу в MS Access и имею очень ограниченный опыт работы с MS Excel VBA.

Моя текущая цель заключается в следующем: мне отправляется «Отчет о расходах» с отчислениями, в этом отчете много столбцов с разными именами учетных записей, которые могут быть заполнены или могут быть нулевыми.

Моим первым шагом будет начать с первой записи (строка 14; столбец A-K содержит личную информацию о вычете), затем перейти к первой учетной записи вычетов (учетные записи вычетов начинаются со столбца L и переходят к столбцу DG), проверяя, является ли каждая ячейка нулевой, если она есть, то продолжайте движение вправоЕсли присутствует значение, мне нужно скопировать его во внешнюю рабочую книгу «Шаблон расчета заработной платы», начиная со строки 2 (столбец J для самого вычета), а также скопировать некоторую личную информацию из исходной строки в «Отчете о расходах», относящейся к этому вычету (currRow: столбец C, E, F от «Отчета о расходах» до столбцов B, C, D «Шаблон расчета заработной платы»).

Затем перемещайтесь вправо, пока следующая ячейка не будет содержать значение, и повторите этот процесс для новой строки в «Шаблоне расчета заработной платы». После выполнения последнего столбца (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>`
  

Ответ №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 amp; "" amp; "Payroll Template.xlsx")
    'or perhaps
    'Set wb2 = Workbooks.Open(Filename:=wb.path amp; "" amp; "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
  

Комментарии:

1. Сработало отлично! Большое вам спасибо