0

我正在尝试将借方/贷方列复制到仅与相应帐户值匹配的其他表中，即所有现金条目都转到现金帐户表等。我还需要一种方法来省略那些已经被复制的（因此必须引用一些检查列）。

但我不清楚如何将其翻译成 VBA。

这是工作表中的视觉效果：

工作表摘录

到目前为止我的 VBA 代码（MyAdd 是将范围复制到另一个指定表的函数）

Sub CopyRange()
For Each c In Range("Journal").Cells
 If c.Value = "Cash" Then
    If Range("Journal[@[Account 1]]").Value = "Cash" Then MyAdd "Cash_Account", Range(c.Offset(0, 2), c.Offset(0, 3))
    Else: MyAdd "Cash_Account", Range(c.Offset(0, 1), c.Offset(0, 2))
Next
End Sub
4

2 回答 2

0

使用 Zack 的解决方案，我以这种方式创建了我的解决方案 - 以防有人想关注我的工作并对其进行改进：

Sub GetNewColumnOfData()

    Dim Table As ListObject
    Dim TargetRange As Range
    Dim Index As Long
    Dim Account As String

    Set Table = Range("Journal").ListObject

    For Index = 1 To Table.ListRows.Count
        If Not IsEmpty(Table.ListColumns("Account 1").DataBodyRange(Index, 1)) And IsEmpty(Table.ListColumns("*").DataBodyRange(Index, 1)) Then
            Account = Table.ListColumns("Account 1").DataBodyRange(Index, 1).Value
            Table.ListColumns("*").DataBodyRange(Index, 1).Value = "*"
            MyAdd Account, Range(Table.ListColumns("Debit").DataBodyRange(Index, 1), Table.ListColumns("Credit").DataBodyRange(Index, 1))
        ElseIf Not IsEmpty(Table.ListColumns("Account 2").DataBodyRange(Index, 1)) And IsEmpty(Table.ListColumns("*").DataBodyRange(Index, 1)) Then
            Account = Table.ListColumns("Account 2").DataBodyRange(Index, 1).Value
            Table.ListColumns("*").DataBodyRange(Index, 1).Value = "*"
            MyAdd Account, Range(Table.ListColumns("Debit").DataBodyRange(Index, 1), Table.ListColumns("Credit").DataBodyRange(Index, 1))
        End If
    Next Index

End Sub

MyAdd 函数是在本网站的其他地方派生的，但我在这里引用它以方便参考：

Sub MyAdd(ByVal strTableName As String, ByRef arrData As Variant)
    Dim tbl As ListObject
    Dim NewRow As ListRow

    Set tbl = Range(strTableName).ListObject
    Set NewRow = tbl.ListRows.Add(AlwaysInsert:=True)

    ' Handle Arrays and Ranges
    If TypeName(arrData) = "Range" Then
        NewRow.Range = arrData.Value
    Else
        NewRow.Range = arrData
    End If
End Sub

请注意，我将此代码放在工作簿的模块中 - 默认情况下，所有范围（表/列表）都是名为范围的工作簿 - 因此无需指定它们所在的工作表即可访问。

于 2020-04-28T06:55:48.557 回答
0

我不确定你为什么要这样做。似乎还有另一个最终目标。但是，可以使用以下代码完成您在 VBA 中要求的操作。

Sub GetNewColumnOfData()

    Dim Table As ListObject
    Dim TargetRange As Range
    Dim Index As Long
    Dim Values As Variant

    Set Table = ThisWorkbook.Worksheets("Sheet3").ListObjects("Journal")
    Set TargetRange = ThisWorkbook.Worksheets("Sheet3").Range("G1")
    ReDim Values(1 To Table.ListRows.Count, 1 To 1)

    For Index = 1 To Table.ListRows.Count
        If Table.ListColumns("Account 1").DataBodyRange(Index, 1).Value = "Cash" Then
            Values(Index, 1) = 1
        ElseIf Table.ListColumns("Account 2").DataBodyRange(Index, 1).Value = "Cash" Then
            Values(Index, 1) = 2
        End If
    Next Index

    TargetRange.Resize(Table.ListRows.Count, 1).Value = Values

End Sub

相应地定义您的范围/表名称。

于 2020-04-27T19:41:44.130 回答