4

我正在寻找一个简单的 excel 宏，它可以根据单元格中的特定数字/值在 excel 中将一行从一个工作表复制到另一个工作表。我有两张床单。一张称为“master”，一张称为“top10”。

这是数据的示例。

数据表示

这是我正在尝试使用的宏：

Sub MyMacro()
Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split("10", ",")
For Each cell In Sheets("master").Range("A:A")
    If (Len(cell.Value) = 0) Then Exit For
        For i = 0 To UBound(aTokens)
            If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("master").Rows(cell.Row).Copy Sheets("top10").Rows(iMatches)
            End If
        Next
Next
End Sub

我确定我正在做一些非常愚蠢的事情，导致它不起作用。我可以运行宏本身而不会出现任何错误，但没有任何内容被复制到我要编译的工作表中。

4

3 回答 3

0

If (Len(cell.Value) = 0) Then Exit For是胡说八道。更改如下：

Sub MyMacro()
Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split("10", ",")
For Each cell In Sheets("master").Range("A:A")
    If Len(cell.Value) <> 0 Then
        For i = 0 To UBound(aTokens)
            If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("master").Rows(cell.Row).Copy Sheets("top10").Rows(iMatches)
            End If
        Next
    End If
Next
End Sub
于 2013-06-29T14:28:53.860 回答
0

正如@Ioannis 提到的，您的问题是主 A3 中的空单元格与您的If (Len(cell.Value) = 0) Then Exit For

我没有使用 thatif来检测范围的结尾，而是使用了以下代码：

LastRow= Sheets("master").Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Sheets("master").Range("A1:A" & LastRow)

结果代码是这样的：

Sub MyMacro()
Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split("10", ",")
Dim LastRow
Dim MyRange 

LastRow = Sheets("master").Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Sheets("master").Range("A1:A" & LastRow)

For Each cell In MyRange
        For i = 0 To UBound(aTokens)
            If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("master").Rows(cell.Row).Copy Sheets("top10").Rows(iMatches)
            End If
        Next
Next
End Sub

我用你的工作簿对此进行了测试，效果很好。:-)

于 2014-10-10T04:05:02.987 回答
0

我相信您的代码在第一行数据之后停止的原因是因为您在下一行中测试的单元格是空的（在您的示例电子表格中），因此您退出循环（因为Len(cell.Value) = 0）。我建议采用不同的方法：高级过滤器完全满足您的需求，而且速度更快。在您的示例电子表格中，您需要插入一个空行 2 并将公式“=10”放在单元格 A2 中。然后下面的代码将做你需要的（假设master是 ActiveSheet）：

Sub CopyData()
    Dim rngData As Range, lastRow As Long, rngCriteria As Range
    With ActiveSheet
        ' This finds the last used row of column A
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Defines the criteria range - you can amend it with more criteria, 
        ' it will still work
        ' 22 is the number of the last column in your example spreadsheet
        Set rngCriteria = .Range(.Cells(1, 1), .Cells(2, 22))

        ' row 2 has the filter criteria, but we will delete it after copying
        Set rngData = .Range(.Cells(1, 1), .Cells(lastRow, 22))

        ' Make sure the destination sheet is clear
        ' You can replace sheet2 with Sheets("top10"), 
        ' but if you change the sheet name your code will not work any more. 
        ' Using the vba sheet name is usually more stable
        Sheet2.UsedRange.ClearContents

        ' Here we select the rows we need based on the filter 
        ' and copy it to the other sheet
        Call rngData.AdvancedFilter(xlFilterCopy, rngCriteria, Sheet2.Cells(1, 1))

        ' Again, replacing Sheet2 with Sheets("top10").. 
        ' Row 2 holds the filter criteria so must be deleted
        Sheet2.Rows(2).Delete
    End With
End Sub

有关高级过滤器的参考，请查看此链接： http ://chandoo.org/wp/2012/11/27/extract-subset-of-data/

于 2013-06-29T18:49:48.403 回答