Question

我正在创建一个带有文本框的UserForm，用户将在其中填写以“;”分隔的名称列表。这些名称可以在工作表的D列中找到。对于每个名称，我想将整行复制并粘贴到另一个工作表中，然后删除原始工作表中的行。我遇到了一些我无法解决的障碍。

Private Sub OK_Click()

Application.Volatile

Dim x As Integer
Dim PINamesArray As String
Dim size As Long
Dim SearchRange As Range
Dim FindRow As Range

Set SearchRange = Range("D5", Range("D2000").End(xlUp))


PINamesArray = Split(Me.PINames, "; ")

size = UBound(PINamesArray) - LBound(PINamesArray) + 1

For x = 1 To size

Set FindRow = SearchRange.Find(x, LookIn:=xlValues, LookAt:=xlWhole)

FindRow.Row
RTBM = FindRow.Row
RTBM.Copy
.Paste Worksheets("Dropped-NotSelected").Cells(ERow, 1)
RTBM.Delete Shift:xlShiftUp


End Sub

我希望Find函数在定界列表中查找与该整数相对应的项目，而不是整数本身。
我知道这段代码可能存在多个方面不正确的地方，但是我很难找到很好的例子作为依据。

Answer 1

试一下-我不得不更改一些变量（并解决了很多奇怪的错别字），但这在我的测试中有效：

Option Explicit
Private Sub CommandButton1_Click()

Dim x As Long, ERow As Long
Dim PINamesArray As Variant
Dim size As Long
Dim SearchRange As Range
Dim FindRow As Long

Set SearchRange = Range("D5:D2000")
ERow = 1

PINamesArray = Split(Me.PINames, "; ")

size = UBound(PINamesArray) - LBound(PINamesArray) + 1

For x = 1 To size

    On Error Resume Next
    FindRow = SearchRange.Find(What:=PINamesArray(x)).Row
    On Error GoTo 0

    If FindRow <> 0 Then
        Rows(FindRow).Copy
        Worksheets("Dropped-NotSelected").Cells(ERow, 1).PasteSpecial
        ERow = ERow + 1
        Rows(FindRow).Delete Shift:=xlShiftUp
    End If

Next x

End Sub

如何从UserForm文本框的分隔列表中查找列中的每个项目

1 个答案: