#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. Сработало отлично! Большое вам спасибо