Question

我正在开展一个项目：

按工作簿中的员工姓名自动筛选数据（原始数据报告）
将该AutoFilter的结果粘贴到工作表中的另一个WB中，该工作表共享该员工的姓名，以便可以针对该个人进行进一步分析。

我不确定原始数据报告的格式是否一致，所以我可能需要在将来调整我的代码。我需要某种循环来使这个过程更有效地运行。

注意：此流程最多需要重复200次，以便为每位员工负责，请参阅下面的代码。

Dim sourceWB As Workbook
Dim destWB As Workbook

Set sourceWB = ThisWorkbook

Workbooks.Open Filename:="C:\users\andrew.godish\Desktop\ChadAT&T\CSCO Separated Data.xlsm"
Set destWB = ActiveWorkbook

'Code that needs to be Repeated
sourceWB.Sheets("Sheet1").Range("A1:K1").AutoFilter Field:=2,   Criteria1:="Employee 1"
sourceWB.Sheets("Sheet1").AutoFilter.Range.Copy Destination:=destWB.Sheets("Employee 1").Range("A" & Rows.Count).End(xlUp)

ActiveCell.Columns("A:P").EntireColumn.Select
ActiveCell.Columns("A:P").EntireColumn.EntireColumn.AutoFit

If sourceWB.Sheets("Sheet1").AutoFilterMode Then  sourceWB.Sheets("Sheet1").ShowAllData

'Code that needs to be Repeated
sourceWB.Sheets("Sheet1").Range("A1:K1").AutoFilter Field:=2,  Criteria1:="Employee 2"
sourceWB.Sheets("Sheet1").AutoFilter.Range.Copy Destination:=destWB.Sheets("Employee 2").Range("A" & Rows.Count).End(xlUp)

ActiveCell.Columns("A:P").EntireColumn.Select
ActiveCell.Columns("A:P").EntireColumn.EntireColumn.AutoFit

If sourceWB.Sheets("Sheet1").AutoFilterMode Then  sourceWB.Sheets("Sheet1").ShowAllData

'Code that needs to be Repeated
sourceWB.Sheets("Sheet1").Range("A1:K1").AutoFilter Field:=2, Criteria1:="Employee 3"
  sourceWB.Sheets("Sheet1").AutoFilter.Range.Copy   Destination:=destWB.Sheets("Employee 3").Range("A" & Rows.Count).End(xlUp)

ActiveCell.Columns("A:P").EntireColumn.Select
ActiveCell.Columns("A:P").EntireColumn.EntireColumn.AutoFit

If sourceWB.Sheets("Sheet1").AutoFilterMode Then sourceWB.Sheets("Sheet1").ShowAllData

因此，正如您所看到的，通过并编辑多达200个这些重复的代码部分并不是一个真正的选择。我知道我需要某种循环，我正在考虑For-Next循环，但我对VBA相对较新，而且我无法围绕究竟需要成为循环变量才能使其工作。谢谢大家！

Answer 1

试试这个

Option Explicit

Sub main()

Dim sourceWB As Workbook
Dim destWB As Workbook
Dim dataRng As Range, employeesRng As Range, cell As Range

Set sourceWB = ThisWorkbook

Workbooks.Open Filename:="C:\users\andrew.godish\Desktop\ChadAT&T\CSCO Separated Data.xlsm"
Set destWB = ActiveWorkbook

Set dataRng = sourceWB.Sheets("Sheet1").Range("A1:K1") '<~~ set your range with data, headers included
Set employeesRng = sourceWB.Sheets("Employees").Range("A:A") '<~~ set your range with employees to process. I thought of names in column A of an "Empolyees" sheet of ThisWorkbook

employeesRng.RemoveDuplicates Columns:=Array(1), Header:=xlYes '<~~ get rid of employeess name duplicates

With dataRng
    For Each cell In employeesRng.SpecialCells(xlCellTypeConstants, xlTextValues) '<~~ loop through actual valid employees names in the empolyees range (no dupes and no blanks)
        .AutoFilter Field:=2, Criteria1:=cell.Value
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<~~ check if there are any filtered values (headers are always there, so look for at least 2 values)
            .Parent.AutoFilter.Range.Copy Destination:=destWB.Sheets(cell.Value).Range("A" & Rows.Count).End(xlUp)
            destWB.Sheets(cell.Value).Columns("A:P").EntireColumn.AutoFit
        End If
        .AutoFilter
    Next cell
End With

End Sub

当然，您必须确保destWB每个员工姓名已经有一张表

否则你必须实现一种表格存在处理技术，就像你可能得到here

一样

循环到自动筛选并评估特定条件

1 个答案: