找到前 30 个字符串匹配并粘贴到位置 A，然后将剩余的字符串匹配粘贴到位置 B

Question

此代码将在我的一个工作表的 E 行中搜索单词 'white' 并将该行上的名称粘贴到我的另一个工作表中。我想要它做的是粘贴前 30 个匹配项，从 第一个匹配项 开始计数，并将其余匹配项粘贴到第二个定义的 x 中。而不是从第 2 行到第 30 行搜索，这是它现在正在做的。如果这没有意义，那么标题就足够简单了。谢谢！

Sub As_Of_Analysis_Sorting()
Dim lr As Long, lr2 As Long, r As Long
Set Sh1 = ThisWorkbook.Worksheets("All Trades")
Set Sh2 = ThisWorkbook.Worksheets("As-Of Trades")
Sh1.Select

Sh2.Cells(1, 1).Value = "Account"
Sh2.Cells(1, 2).Value = "Amount"
lr = Sh1.Cells(Rows.Count, "A").End(xlUp).row
x = 2
For r = 2 To 30
    If Range("E" & r).Value = "WHITE" Then
        Sh2.Cells(x, 1).Value = Sh1.Cells(r, 2).Value
        Sh2.Cells(x, 2).Value = Sh1.Cells(r, 3).Value
        x = x + 1
    End If
Next r
x = 35
For r = 31 To lr
    If Range("E" & r).Value = "WHITE" Then
        Sh2.Cells(x, 1).Value = Sh1.Cells(r, 2).Value
        Sh2.Cells(x, 2).Value = Sh1.Cells(r, 3).Value
        x = x + 1
    End If
Next r
Sh2.Select
End Sub

Answer 1

Sub As_Of_Analysis_Sorting()
Dim lr As Long, lr2 As Long, r As Long, x As Long
Dim i as Long
Set Sh1 = ThisWorkbook.Worksheets("All Trades")
Set Sh2 = ThisWorkbook.Worksheets("As-Of Trades")


Sh2.Cells(1, 1).Value = "Account"
Sh2.Cells(1, 2).Value = "Amount"
lr = Sh1.Cells(Rows.Count, "A").End(xlUp).Row

x = 2
i = 0
For r = 2 To lr
    If Sh1.Range("E" & r).Value = "WHITE" Then
        Sh2.Cells(x, 1).Value = Sh1.Cells(r, 2).Value
        Sh2.Cells(x, 2).Value = Sh1.Cells(r, 3).Value
        x = x + 1
        i = i + 1
        If i = 30 Then x = 35
    End If
Next r

Sh2.Select
End Sub

找到前 30 个字符串匹配并粘贴到位置 A，然后将剩余的字符串匹配粘贴到位置 B

Find first 30 string matches & paste at location A, then paste remaining string matches at location B

excel

vba

copy-paste

string-matching

worksheet-function