时间戳

首页 > 解决方案 > 从 Excel 中的表进行条件复制

excel - 从 Excel 中的表进行条件复制

问题描述

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

但我不清楚如何将其翻译成 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

标签： excelvbastructured-references

解决方案

使用 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

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

推荐阅读