从工作表中选择要保存的特定列

Question

我正在与电子表格上的朋友合作，我们正在应用多个过滤器。

第一个过滤器在M和U列上运行：

Sub TokenNotActivated()

'Col H = Laptop - Main
'Col H = Desktop
'Col M = Yes
'Col U = provisioned
ThisWorkbook.Sheets(2).Activate
ActiveSheet.Range("A2:Z2").Select
Selection.AutoFilter Field:=8, Criteria1:="Desktop", Operator:=xlOr, Criteria1:="Laptop - Main"
Selection.AutoFilter Field:=13, Criteria1:="Yes"
Selection.AutoFilter Field:=21, Criteria1:="provisioned", Operator:=xlFilterValues

End Sub

第二个过滤器对F列起作用，过滤在那里找到的每个唯一值

e.g。

将作为John，Sarah，Frank的过滤器返回。此外，如果在运行第一组过滤器之后没有为其中任何一个找到任何行，则跳过它。负责此的代码如下：

Sub GetPrimaryContacts()

Dim Col As New Collection
Dim itm
Dim i As Long
Dim CellVell As Variant

'Get last row value
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row

'Loop between all rows to get unique values
For i = 3 To LastRow
    CellVal = Sheets("Master").Range("F" & i).Value
    On Error Resume Next
    Col.Add CellVal, Chr(34) & CellVal & Chr(34)
    On Error GoTo 0
Next i

' Create workbooks - Token Not activated
Call TokenNotActivated
For Each itm In Col
    ActiveSheet.Range("A2:Z2").Select
    Selection.AutoFilter Field:=6, Criteria1:=itm
    Call TokenNotActivatedProcess
Next

ActiveSheet.AutoFilter.ShowAllData

End Sub

我要做的第三件事是为应用第二个过滤器后显示的每个结果创建一个保存在C：\ Working \中的新电子表格。请参阅应用第二个过滤器后，电子表格以某种方式“重置”并允许新的过滤过程（请参阅上面的代码）。我一直在玩，以确保我得到正确的数据。通过打印到立即窗口，它是正确的。执行此操作的代码如下：

' Run the process to get the workbook saved
Function TokenNotActivatedProcess()
    Dim r As Range, n As Long, itm, FirstRow As Long
    n = Cells(Rows.Count, 1).End(xlUp).Row
    Set r = Range("A1:A" & n).Cells.SpecialCells(xlCellTypeVisible)
    FirstRow = ActiveSheet.Range("F2").End(xlDown).Row
    itm = ActiveSheet.Range("F" & FirstRow).Value
    If r.Count - 2 > 0 Then Debug.Print itm & " - " & r.Count - 2
End Function

我现在的问题是 - 如何从第3行到最后一行（应用两个过滤器后）选择A，B，C，D，E，Z列，然后在每次迭代时将其保存到外部Excel电子表格中过滤过程？我只对在立即窗口中产生值的输出感兴趣（即，有可见单元格可见的位置）。理想情况下，我希望以下列格式使用它们：

TokenNotActivated - Sarah - 110514.xlsx
TokenNotActivated - John - 110514.xlsx
TokenNotActivated - Jack - 110514.xlsx

Answer 1

让我们稍微修改你的函数并让它返回一个值：

Function TokenNotActivatedProcess() As Boolean
    Dim r As Range, n As Long, itm, FirstRow As Long, ret as Boolean
    n = Cells(Rows.Count, 1).End(xlUp).Row
    Set r = Range("A1:A" & n).Cells.SpecialCells(xlCellTypeVisible)
    FirstRow = ActiveSheet.Range("F2").End(xlDown).Row
    itm = ActiveSheet.Range("F" & FirstRow).Value
    If r.Count - 2 > 0 Then 
        Debug.Print itm & " - " & r.Count - 2
        ret = True
    End If
    TokenNotActivatedProcess = ret
End Function

然后，您可以更改For each itm in Col循环。而不是调用函数，只是将它作为布尔逻辑的一部分进行评估，因为它返回一个布尔值，你可以这样做。

Dim ws As Worksheet
Set ws = ActiveSheet

For Each itm In Col
    ws.Range("A2:Z2").AutoFilter Field:=6, Criteria1:=itm
    If TokenNotActivatedProcess Then

        'Dim wbNew as Workbook
        'Set wbNew = Workbooks.Add
        '
        '### Add code here which will create a new workbook
        '    and copy the data to the new workbook.
        '    This would probably be another subroutine or function.
        '
        'wbNew.SaveAs "C:\new file.xlsx"
        'wbNew.Close

    End If
Next

此最终会修复它，但您依赖的是Activate和Selection方法，当您使用多个工作簿时会出现问题，如下所述：

How to avoid using Select in Excel VBA macros

我修改了上面的循环以避免这种情况，但可能还有其他地方需要修复。

如果您无法修改代码以避免使用Activate / Select方法，或者在添加新工作簿以复制数据时遇到问题，请使用当前代码更新您的问题。这样做应该不是很困难。