VBA Excel过滤数据并复制到另一个工作表 - 新手警报

时间:2015-10-08 07:13:43

标签: excel-vba vba excel

嗨,对于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

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

杰森

2 个答案:

答案 0 :(得分:1)

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

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

答案 1 :(得分: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

那么,这是关于什么的:

代码的逻辑是

  • 使用Months(即德语)的名称过滤两列第1列,第2列通过删除空白/空单元格来过滤元素
  

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

  • 包含要应用过滤的表的工作表的名称是“源”。离开。自动过滤到虚假

      

    .AutoFilterMode = False

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

  

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

第2栏

  

.AutoFilter Field:= 2,Criteria1:=“&lt;&gt;”

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

使用.Range(“$ A $ 21”&amp;“:”&amp;“$ C $”&amp; 300)

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

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

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

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

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

计算行数,这对你来说可能有点复杂,但最后应该支付它的便士。

据说你想要计算B列中的行数(变量)      FinalRowChartSheet = Range(“B7”)。End(xlDown).Row

祝你最好。我希望我能帮助你。

如果你发现它有用,别忘了评价我的答案。谢谢。