Question

我面临的问题是关于Excel。我正在尝试根据特定条件从表单中提取多列的行。我已经找到了一些解决方案，但没有什么是我正在寻找的，或者我无法改变它以使其工作。我将尝试使用示例解释下面更详细的问题。

情况：

8张（名为Sh1至Sh8），其中包含任务列表
每张表都代表一种任务（个人，工作......）
每张表格具有相同的格式
数据位于第4行，A列到K
数据下方是一个总计算行
数据包括文字，数字和空白单元格
D列是任务的状态（C表示已完成，I表示正在进行，N表示尚未开始）
使用条件格式

我想要检查那些8张并将所有条目（包括空白单元格）复制到一张名为“过滤”的新工作表中的特定状态（C，I或N）。过滤表也将包含标题，数据应从第7行开始。

当我开始这个时，我想出了一个公式（基于this），它复制了一张表的所有条目。我可以通过将C，I或N放在过滤纸上的单元格D4中来过滤它。

{
=IFERROR(
         INDEX(
               Sh1!A$4:A$19;SMALL(
                                  IF(
                                      Sh1!$D$4:$D19=Filtering!$D$4;
                                      ROW(Sh1!A$4:A$19)-ROW(Sh1!A$4)+1
                                     );
                                  ROWS(Sh1!A$4:Sh1!A4)
                                 )
               );
        "")
}

正如我之前所说，数据包括空白单元格，因此我将公式更改为以下内容以确保空白单元格不会变为0：

{
=IFERROR(
         IF(
            INDEX(SAME AS ABOVE)="";
            "";
            INDEX(SAME AS ABOVE);
           );
         "")
}

虽然这有效，但我只能在一张纸上执行此操作，而不是全部八张。我可以通过在过滤表中的较低行开始Sh2来解决这个问题，并为所有其他表单执行此操作，但这不是我想要的。我真的想通过更改过滤表上的一个单元格D4来获得一个连续列表，该列表总结了所有未启动，已完成或正在进行的操作。

这就是我想要你的建议的地方。如果没有VBA就可以做到这一点，我宁愿这样做，因为我有时会在在线网络应用程序中使用它而宏在那里不起作用。如果VBA是唯一的解决方案，那显然也没关系。

旁注：我根据我找到here的代码尝试了VBA。（请耐心等待我，在此之前我从未编码过）但处理这个问题似乎很慢。每次运行宏时，计算它都需要15秒以上，尽管我目前只有200个任务。以下是获取所有已完成任务的内容。我可以通过将C更改为I或N来轻松地制作其他内容。还有另一个问题，即整个工作表被移除，包括我的标题，所以我必须在清除范围内放置一个范围。

Sub ExtractList() 

Dim ws As Worksheet 
Dim destinationWorksheet As Worksheet 
Dim columnD As Range 
Dim c As Range 
Dim count As Long 

Set destinationWorksheet = ActiveWorkbook.Worksheets("Filtering") 

destinationWorksheet.Cells.ClearContents 

count = 1 
For Each ws In ActiveWorkbook.Worksheets 

    If ws.Name = "Sh1" Or ws.Name = "Sh2" Or ws.Name = "Sh3" Or ws.Name 
    = "Sh4" Or ws.Name = "Sh5" Or ws.Name = "Sh6" Or ws.Name = "Sh7" Or
    ws.Name = "Sh8" Then

        Set columnD = ws.Range("D:D") 'columnD
        For Each c In columnD 

            If WorksheetFunction.IsText(c.Value) Then 
                If InStr(c.Value, "C") > 0 Then 
                    c.EntireRow.Copy 
                    destinationWorksheet.Cells(count, 1).PasteSpecial xlPasteValuesAndNumberFormats 
                    count = count + 1 
                End If 
            End If 
        Next c 

    End If 

Next ws 

End Sub

非常感谢您阅读本文，我期待着您的建议。

干杯，巴特

Answer 1

您的代码运行时间太长的原因是因为您循环遍历整个列。您需要划定要使用的范围。

此解决方案：

•允许用户使用“过滤”工作表（目标）中的单元格D4确定提取条件

•设置每个工作表的数据范围[Sh1，Sh2，Sh3，Sh4，Sh5，Sh6，Sh7，Sh8]（来源）

•使用AutoFilter选择所需数据和

•在“过滤”工作表

中过帐所有工作表的结果范围

它假设：

•所涉及的所有工作表都具有相同的结构和标题

•标题位于目标工作表的A6:K6和源工作表的A3:K3（根据需要进行更改）

Sub ExtractList()
Dim wshTrg As Worksheet, wshSrc As Worksheet
Dim sCriteria As String
Dim rDta As Range
Dim rTmp As Range, rArea As Range, lRow As Long

    Rem Set Worksheet Target
    Set wshTrg = ThisWorkbook.Worksheets("Filtering")   'change as required

    Rem Clear prior data 'Header at row 6 & data starts at row 7 - change as required
    With wshTrg
        Rem Sets Criteria from Cell [D4] in target worksheet
        sCriteria = .Cells(4, 4).Value2
        .Cells(7, 1).Value = "X"    'To set range incase there is only headers
        .Range(.Cells(7, 1), .UsedRange.SpecialCells(xlCellTypeLastCell)).ClearContents
    End With

    Rem Process each worksheet
    lRow = 7
    For Each wshSrc In ThisWorkbook.Worksheets
        Select Case wshSrc.Name
        Case "Sh1", "Sh2", "Sh3", "Sh4", "Sh5", "Sh6", "Sh7", "Sh8"
            With wshSrc
                Rem Clear AutoFilter
                If Not (.AutoFilter Is Nothing) Then .Cells(1).AutoFilter
                Rem Set Data Range
                Set rDta = .Range(.Cells(3, 1), .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 11))
            End With

            With rDta
                Rem Apply AutoFilter
                .AutoFilter Field:=4, Criteria1:=sCriteria
                Rem Set resulting range
                Set rTmp = .Offset(1).Resize(-1 + .Rows.count).SpecialCells(xlCellTypeVisible)
                Rem Clear Autofilter
                .AutoFilter
            End With

            Rem Post Resulting range in target worksheet
            For Each rArea In rTmp.Areas
                With rArea
                    wshTrg.Cells(lRow, 1).Resize(.Rows.count, .Columns.count).Value = .Value2
                    lRow = lRow + .Rows.count

    End With: Next: End Select: Next
    End Sub

建议阅读以下页面以深入了解所使用的资源：

Range Object (Excel)，Range.Offset Property (Excel)， Range.SpecialCells Method (Excel)，

Select Case Statement，Worksheet.AutoFilter Property (Excel)，

Worksheet.AutoFilterMode Property (Excel)，With Statement

根据条件从多个工作表中提取列表

1 个答案: