Question

我正在寻找一个Excel宏，我有一个示例数据集，如下所示。此数据位于Excel的Sheet1。

BG.   test1  743,
DF.   test2  34,
GH.   test3  20,
DF.   test4  29, and
WS.   test5  3

我希望仅复制包含BG. test1，GH. test3 20和DF. test4 29数据的特定单元格。

Sub test()
'
' testing Macro
'
' Keyboard Shortcut: Ctrl+r
'

For Each Cell In Sheets(1).Range("A:A")
    If Cell.Value = "BG.   test1" Then
        matchRow = Cell.Row
        Rows(matchRow).Select
        Selection.Copy

        Sheets("Sheet1").Select
        lastRow = ActiveSheet.UsedRange.Rows.Count
        If lastRow > 1 Then lastRow = lastRow + 1
        ActiveSheet.Range("A" & lastRow).Select
        ActiveSheet.Paste
        Sheets("Sheet1").Select

    End If
Next

End Sub

我能够拉出包含BG. test1的行，但由于收到错误，我无法拉出其他两行。

Answer 1

这会对你有所帮助

Sub test()
'
' testing Macro
'
' Keyboard Shortcut: Ctrl+r
'
lrow = Thisworkbook.Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
i = lrow
For Each Cell In Sheets(1).Range("A:A")
If Cell.Value = "BG.   test1" Or Cell.Value = "GH.   test3  20" or Cell.Value= "DF.   test4  29"Then

Worksheets("Sheet2").Cells(i, 1).EntireRow.Value = cell.EntireRow.Value
     i = i + 1      

End If
Next
End Sub

这里它将验证表1的A列，如果我们的搜索字符串匹配，那么它将把整个roe送到下一张表。

谢谢

Answer 2

尝试以下方法：

＆＃39;＆＃34; BG。 TEST1＆＃34;＆＃34; GH。 test3 20＆＃34;，＆＃34; DF。 test4 29＆＃34;

我已经使用Instr检查该字符串是否在单元格中，否则您可以使用

If test = "BG.   test1" Or test = "GH.   test3  20" Or test = "DF.   test4  29" Then

使用union是一次写出行的有效方法。

代码：

Option Explicit
Sub GetRows()

Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim loopRange As Range
Dim unionRange As Range
Dim currentCell As Range
Dim ws2 As Worksheet
Dim lastRow2 As Long

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1") 'change
Set ws2 = wb.Worksheets("Sheet2")
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

Set loopRange = ws.Range("A1:A" & lastRow)

For Each currentCell In loopRange

    Dim test As String

    test = currentCell.Text

    If InStr(1, test, "BG.   test1") > 0 _
     Or InStr(1, test, "GH.   test3  20") > 0 _
     Or InStr(1, test, "DF.   test4  29") > 0 Then

        If Not unionRange Is Nothing Then
            Set unionRange = Union(unionRange, currentCell.EntireRow)
        Else
            Set unionRange = currentCell.EntireRow
        End If
    End If

    Next currentCell

    If Not unionRange Is Nothing Then
    unionRange.Copy ws2.Range("A" & IIf(lastRow2 = 1, 1 ,lastRow2+ 1))
    End If

End Sub

在数据列中搜索特定文本

2 个答案: