Excel VBA 中的抵消解决方法

Question

我正在尝试自动将会计日记帐分录过帐到分类帐，但在添加新行后却难以抵消。我的工作簿有两张纸，日记帐和分类帐，我的目标是阅读每个日记帐条目并通过添加新行将条目添加到分类帐中正确的 T 帐户。大多数复制条目都有效，但一旦偏移发生变化，宏就会遇到问题。我正在考虑使用 .Find 作为更好的选择，因为不同的 T 账户需要不同的抵消值，具体取决于有多少以前的账户高于它们。我该如何解决这个偏移行问题？

这里是 link 到 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

编辑。如果我要寻求 Range.Find 解决方案，我如何才能获得此 Range/cell 结果？现在我得到 "Run-time error '91': Object variable or With block variable not set".

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 or 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 和您的变量 row 之间没有混淆。您可以看到 VBE 已经混淆了，因为它将属性设置为小写。

Excel VBA 中的抵消解决方法

Offsetting Workaround in Excel VBA

excel

accounting

vba