【问题标题】:VBA Excel filter data and copy to another worksheet - Newbie alertVBA Excel 过滤数据并复制到另一个工作表 - 新手警报
【发布时间】:2021-03-20 00:39:18
【问题描述】:

您好,我是 VBA Excel 的新手。

我正在尝试过滤一个可变大小的电子表格,其中包含在一列中查找一组单词的数据。找到后,我想将整个行复制到另一个工作表。

因为他们可能不止一行包含这个词,所以我不想覆盖上一个复制的行。

这是我为查找单词而创建的,但是如何将行复制到另一个工作表?

Sheets("Sheet1").Select                                 'Select datasheet
Range("A1").Select                                      'Set cell position to start search from

Do Until Selection.Offset(0, 4).Value = ""              'word to be searched is 4 cell in
                                                        'do what is required
    If Selection.Offset(0, 4).Value = "UKS" Then
        MsgBox "Found"                                  'Found it!
        'not sure how to copy row to another worksheet
    End If

'finish move on to next one in list
         Selection.Offset(1, 0).Select                  'move down 1 row
    Loop

    Range("A1").Select ' reset cell position

任何帮助将不胜感激,请您解释一下它是如何工作的,以及我想理解的,而不仅仅是复制。

杰森

【问题讨论】:

    标签: excel vba


    【解决方案1】:

    往下看,也许它会给你一些线索。 不过,我会尽量对细节发表评论,让您熟悉此事。

    我的示例稍微复杂一些,因为它同时对两列应用过滤,但它有利于您理解它的复杂性,因为您可以进一步应用它。

     With Sheets("Source")
                .AutoFilterMode = False
            With .Range("$A$21" & ":" & "$C$" & 300)
                 .AutoFilter Field:=1, Criteria1:=Array("April", "August", "Dezember", "Februar", "Januar", "Juli", "Juni", "Mai", "März", "November", "Oktober", "September"), Operator:=xlFilterValues
                 .AutoFilter Field:=2, Criteria1:="<>"
                 ActiveSheet.AutoFilter.Range.Copy
                 Sheets("Chart").Select
                 Range("A7").Select
                Sheets("Chart").Paste
             End With
            End With
    

    那么,这是关于什么的:

    代码的逻辑是

    • 过滤两列第 1 列按月份名称(即德语),第 2 列通过消除空白/空单元格来过滤元素

    使用表格(“来源”) .AutoFilterMode = False 使用 .Range("$A$21" & ":" & "$C$" & 300) .AutoFilter Field:=1, Criteria1:=Array("April", "August", "Dezember", "Februar", "Januar", "Juli", "Juni", "Mai", "März", "November ", "Oktober", "September"), 运算符:=xlFilterValues

    • 包含要应用过滤的表的工作表的名称是“源”。将 .Autofiltering 保留为 false

      .AutoFilterMode = False

    • 过滤值设置如下: 第 1 列

    .AutoFilter Field:=1, Criteria1:=Array("April", "August", "Dezember", "Februar", "Januar", "Juli", "Juni", "Mai", "März" , "十一月", "十月", "九月"), 运算符:=xlFilterValues

    第 2 栏

    .AutoFilter Field:=2, Criteria1:=""

    • 最后但并非最不重要(非常重要)是范围(应用过滤的表格的单元格)

    使用 .Range("$A$21" & ":" & "$C$" & 300)

    在这种情况下,我的示例将过滤器应用于从 A21 开始到 C300 结束的一系列单元格(实际上是一个表格)。

    为什么选择 A21? 因为那是我的数据被复制的地方。它总是从 A21 开始。

    为什么选择 C300? 因为最大行数永远不会超过 (300-21)=279 行 我的数据模型在任何时候都不会超过 279 个未过滤的行,您可以根据您的假设放一个更大的数字。 如果有更多行,没关系,因为我通过消除空白过滤了它们,见上文。

    顺便说一句,“kosher”版本是通过 VBA 计算行数并在定义范围时使用它。

    您可以简单地使用一个涵盖表中可能行数的非常大的数字。

    计算行数这对你来说乍一看可能有点复杂,但最终会付出代价。

    假设您想计算 B 列中的行数(变量) FinalRowChartSheet = Range("B7").End(xlDown).Row

    祝你一切顺利。希望对你有所帮助。

    如果您觉得我的回答有用,请不要忘记给它评分。谢谢。

    【讨论】:

      【解决方案2】:

      这是一个循环代码示例和一个过滤器代码示例。

      Sub loopMe()
      
          Dim sh As Worksheet, ws As Worksheet
          Dim LstR As Long, rng As Range, c As Range
      
          Set sh = Sheets("Sheet1")    'set the sheet to loop
          Set ws = Sheets("Sheet2")    'set the sheet to paste
          With sh    'do something with the sheet
              LstR = .Cells(.Rows.Count, "D").End(xlUp).Row    'find last row
              Set rng = .Range("D2:D" & LstR)    'set range to loop
          End With
      
          'start the loop
          For Each c In rng.Cells
              If c = "UKS" Then
                  c.EntireRow.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)    'copy row to first empty row in sheet2
              End If
          Next c
      
      End Sub
      
      Sub FilterMe()
          Dim sh As Worksheet, ws As Worksheet
          Dim LstR As Long, rng As Range
      
          Set sh = Sheets("Sheet1")    'set the sheet to filter
          Set ws = Sheets("Sheet2")    'set the sheet to paste
          Application.ScreenUpdating = False
          With sh    'do something with the sheet
              LstR = .Cells(.Rows.Count, "D").End(xlUp).Row    'find last row
              .Columns("D:D").AutoFilter Field:=1, Criteria1:="UKS"
              Set rng = .Range("A2:Z" & LstR).SpecialCells(xlCellTypeVisible)    'Replace Z with correct last column
              rng.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
              .AutoFilterMode = False
          End With
      
      End Sub
      

      【讨论】:

        猜你喜欢
        • 1970-01-01
        • 2015-12-23
        • 2016-11-19
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 2013-10-26
        相关资源
        最近更新 更多