从工作表中选择特定列进行保存

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 列，过滤在那里找到的每个唯一值

例如

将作为 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

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

如果您在修改代码以避免使用激活/选择方法时遇到问题，或者如果您在添加新工作簿以复制数据时遇到问题，只需使用当前代码更新您的问题。做到这一点应该不是很困难。