Обходное решение в Excel VBA

Question

Я пытаюсь автоматизировать запись записей бухгалтерского учета в бухгалтерскую книгу и борюсь со смещением после добавления новых строк. В моей книге есть два листа, журнал и книга, и моя цель - прочитать каждую запись в журнале и добавить запись в правильный T-счет в книге, добавив новую строку. Большинство записей копирования работают, но макрос сталкивается с проблемами после изменения смещения. Я рассматривал возможность использования .Find в качестве лучшего варианта, поскольку разные T-счета нуждаются в разных значениях смещения в зависимости от того, сколько предыдущих учетных записей находится над ними. Как я могу решить эту проблему смещения строк?

Вот ссылка на Excel File, а ниже - мой код в VBA.

Sub RowInsert() 

Dim offset As Integer 
offset = 0 

Dim counter As Integer 
For counter = 0 To 1 

Dim account As String 
account = Worksheets("Journal").Cells(counter + 2, 2) 


Dim a As Double 

If Worksheets("Journal").Cells(counter + 2, 2) = "Cash" Then 
Worksheets("Ledger").Rows(4 + offset).Insert Shift:=xlDown 

offset = offset + 1 

Worksheets("Ledger").Cells(6 + offset, 1).Value = Worksheets("Journal").Cells(counter + 2, 1).Value 

    If Worksheets("Journal").Cells(counter + 2, 3).Value = Null Then 
    Worksheets("Ledger").Cells(6 + offset, 3).Value = Worksheets("Journal").Cells(counter + 2, 4).Value 
    Else 
    Worksheets("Ledger").Cells(6 + offset, 2).Value = Worksheets("Journal").Cells(counter + 2, 3).Value 
    End If 

ElseIf Worksheets("Journal").Cells(counter + 2, 2) = "Equipment" Then 
Worksheets("Ledger").Rows(8 + offset).Insert Shift:=xlDown 

offset = offset + 1 

Worksheets("Ledger").Cells(6 + offset, 1).Value = Worksheets("Journal").Cells(counter + 2, 1).Value 

    If Worksheets("Journal").Cells(counter + 2, 3).Value = Null Then 
    Worksheets("Ledger").Cells(6 + offset, 3).Value = Worksheets("Journal").Cells(counter + 2, 4).Value 
    Else 
    Worksheets("Ledger").Cells(6 + offset, 2).Value = Worksheets("Journal").Cells(counter + 2, 3).Value 
    End If 

End If 
Next counter 
End Sub 

EDIT. Если бы я должен был выполнить решение Range.Find, как я могу получить доступ к этому результату Range/cell? Прямо сейчас я получаю «Ошибка времени выполнения 91»: переменная объекта или с переменной блока не установлена ​​».

Sub RowInsert() 

Dim counter As Integer 
For counter = 0 To 1 

Dim account As String 
account = Worksheets("Journal").Cells(counter + 2, 2) 


Dim a As Double 

If Worksheets("Journal").Cells(counter + 2, 2) = "Cash" Then 

    Dim entries As Integer 
    entries = 0 
    Dim Header As Range 
    Dim row As Long 

    With Worksheets("Ledger").Range("a1:a100") 

     Set Header = .Find("Cash") 
     ` Error here when try to use the Range Header 
     row = Header.row + entries 

     Rows(row).Insert Shift:=xlDown 

     Cells(row, 1) = Worksheets("Journal").Cells(counter + 2, 1).Value 

    End With 

End If 
Next counter 

End Sub 

Answer 1

Ответ на отредактированном вопрос:

Ошибка вы получаете, потому что .Find ничего не нашел и вернулся Nothing. Попытка доступа к свойствам Nothing даст ошибку «Object variable или With block variable not set».

.Find не обрабатывает объединенные ячейки, которые хорошо. Простое решение в вашем случае - расширить диапазон поиска, чтобы он включал всю объединенную ячейку.

Dim Header As Range 
Dim lastRow As Long 

With Worksheets("Ledger").Columns("A:C") 

    Set Header = .Find("Cash") 
    lastRow = Header.Row + entries 
    'I would prefer something like 
    'lastRow = Worksheets("Ledger").Cells(Header.Row, "B").End(xlDown).Row (not tested) 

    Rows(lastRow).Insert Shift:=xlDown 

    Worksheets("Ledger").Cells(lastRow, 1) = Worksheets("Journal").Cells(counter + 2, 1).Value 
End With 

Я изменил имя переменной строки, так что нет никакой путаницы между свойством и вашей переменной row. Вы можете видеть, что VBE уже запутался, поскольку он устанавливает свойство в нижний регистр.