每次在子vba中使用时更改变量结果

Question

我有从一个工作表到另一个工作表排序和复制结果的代码。有时我需要将复制的区域粘贴到所选工作表上的下一个空白单元格中，为此我需要使用ActiveSheet.Cells(Rows.Count，1).End(xlUp).Row。

        Worksheets("Wallets").AutoFilterMode = False

        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=5, Criteria1:="*TRANSFER*"
        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=7, Criteria1:=">0"
                 Worksheets("Wallets").Range("B2:I" & Worksheets("Wallets").Cells(Rows.Count, 1).End(xlUp).Row).Copy
                 Worksheets("Transfers").Cells(Worksheets("Transfers").Cells(Rows.Count, 1).End(xlUp).Row, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValue

        Worksheets("Wallets").AutoFilterMode = False

        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=5, Criteria1:="*EXCHANGE*"
        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=7, Criteria1:=">0"
                 Worksheets("Wallets").Range("B2:I" & Worksheets("Wallets").Cells(Rows.Count, 1).End(xlUp).Row).Copy
                 Worksheets("Transfers").Cells(Worksheets("Transfers").Cells(Rows.Count, 1).End(xlUp).Row, 1).Offset(1, 0)..PasteSpecial Paste:=xlPasteValues

例如，我正在考虑更改代码，以便在需要对某些工作表使用其他列时可以更容易地替换此部分。有没有办法让变量每次在sub中使用时都重新计算？下面的部分代码只是保存第一个结果并使用它，但我需要为当前使用的每个工作表更新行数(最好不要使用Worksheets.Select)。

Sub Sort_Wallets()
Dim x As Long

       x = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    

        Worksheets("Wallets").AutoFilterMode = False
        Worksheets("Wallets").Select
        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=5, Criteria1:="*TRANSFER*"
        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=7, Criteria1:=">0"
                 Worksheets("Wallets").Range("B2:I" & x).Copy
                 Worksheets("Transfers").Select
                 Worksheets("Transfers").Cells(x, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                 

        Worksheets("Wallets").AutoFilterMode = False
        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=5, Criteria1:="*EXCHANGE*"
        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=7, Criteria1:=">0"
                 Worksheets("Wallets").Range("B2:I" & x).Copy
                 Worksheets("Transfers").Cells(x, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End Sub

Answer 1

如果您正在循环遍历工作表，则可以，但如果仅使用两个工作表，则不能。您将需要指定工作表。您在每种情况下都使用x作为最后一行，我怀疑这是真的。如果要查找最后一行，为什么要设置J10000？此外，看起来您只想在过滤后复制可见的单元格。您需要指定只需要可见的单元格。如果你对变量、范围和工作表进行Set，这样就不会重复很长的行，这样代码就更容易理解了。这是我刚才使用你的代码所说的一个例子。甚至可能有更好的解决方案，但这比你所拥有的更具可读性。

Sub Sort_Wallets()
    Dim destlr As Long
    Dim sourcelr As Long
    Dim wk1 As Worksheet
    Dim wk2 As Worksheet
    Dim FiltRng As Range
    
    Set wk1 = ThisWorkbook.Worksheets("Wallets")
    Set wk2 = ThisWorkbook.Worksheets("Transfers")
    
    
    destlr = wk2.Cells(Rows.Count, 1).End(xlUp).Row
    sourcelr = wk1.Cells(Rows.Count, 1).End(xlUp).Row
    
    Set FiltRng = wk1.Range(wk1.Cells(1, 1), wk1.Cells(sourcelr, 10))
    
    wk1.AutoFilterMode = False
       
    FiltRng.AutoFilter Field:=5, Criteria1:="*TRANSFER*"
    FiltRng.AutoFilter Field:=7, Criteria1:=">0"
    wk1.Range("B2:I" & sourcelr).SpecialCells(xlCellTypeVisible).Copy

    wk2.Cells(destlr, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
             

    wk1.AutoFilterMode = False
    FiltRng.AutoFilter Field:=5, Criteria1:="*EXCHANGE*"
    FiltRng.AutoFilter Field:=7, Criteria1:=">0"
    wk1.Range("B2:I" & sourcelr).SpecialCells(xlCellTypeVisible).Copy
    
    wk2.Cells(destlr, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
End Sub

Answer 2

假设您正在使用像数据表这样的工作表，请使用“表”。对于每个数据表，将其突出显示并插入表格，然后进入表格功能区(仅当光标位于该表格中时可用)，并将表格的名称从任何名称("Table5")更改为对您有意义的名称。

在VBA中，这些被称为ListObjects。只要您知道这些表的名称，就可以使用以下代码获取它们：

'Returns the specified object from a collection
'Returns Nothing if the value in the collection doesn't exist.
'Throws no errors
Private Function GetFromCollection(col As Collection, sKey As String) As Object
    On Error Resume Next
    Set GetFromCollection = col.item(sKey)
    Err.Clear
End Function

Public Function GetListObjectFromWorkbook(sTableName As String, Optional bRecache As Boolean = False) As ListObject
    Static bInitialized As Boolean
    Static col As Collection
    Dim lo As ListObject
    Dim sht As Worksheet
    
    If bRecache Or Not bInitialized Then
        Set col = New Collection
        For Each sht In Sheets
            For Each lo In sht.ListObjects
                col.Add lo, lo.Name
            Next lo
        Next sht
        bInitialized = True
    End If
    Set GetListObjectFromWorkbook = GetFromCollection(col, sTableName)
End Function

这样，您就不需要知道最后一行在哪里了！添加新行的步骤如下：

Dim listrow As ListRow
Set listrow = GetListObjectFromWorkbook(sTableName).ListRows.Add

您可以通过listrow.Range操作这个新ListRow的值

仅供参考:你也可以对ListObjects进行排序。请参阅https://docs.microsoft.com/en-us/dotnet/api/microsoft.office.tools.excel.listobject.sort?view=vsto-2017中的VB代码