Question

我是新手。我刚刚编写了一个代码，它复制了一系列单元格，并查看这些单元格左侧相邻列中的前3个数字。例如：如果A1和A5的前三个数字是100而不是复制B1：D1和B5：D5到新工作簿。一开始我使用输入框输入数字（100）来查找我想要复制的范围。现在我想使用多个输入。就像我想将100右边的单元格复制到一个新的工作簿，并将120右边的单元格复制到另一个只有一个代码的新工作簿...我使用listbox编写了一个代码。然而问题是每当我选择多个项目，如100 110 120，它不起作用。它将包含100的单元格的右侧相邻单元格复制到新工作簿，而不是将右侧单元格100复制到另一个新工作簿。我被困住等待一个人来照亮我。对不起我的英语，我不是母语人士。无论如何这里是代码：

Private Sub Userform_Initialize()
With ListBox1
.AddItem "100"
.AddItem "110"
.AddItem "120"
End With

ListBox1.ListIndex = 0

End Sub

Private Sub OKButton_Click()

Dim c As Range
Dim rRng As Range
Dim LRow As Range
Dim rRng2 As Range
Dim i As Integer

ChDir "C:\Users\Loff1\Desktop\CreatedBD"


For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
LedAcc = ListBox1.List(i)


For Each c In Workbooks("Test.xlsx").Sheets("TestBD").Range("A2:A100")

    If LedAcc = Left(c, 3) Then

        If rRng Is Nothing Then
            Set rRng = c
        Else
            Set rRng = Application.Union(rRng, c)
        End If
    End If
Next

Set rRng2 = rRng.Offset(0, 3)

Workbooks("Test.xlsx").Sheets("TestBD").Select
Range(rRng, rRng2).Select
Selection.Copy

Set NewBook = Workbooks.Add
NewBook.Sheets("Sheet1").Select
Range("B9").Select
ActiveSheet.Paste

Range("A6").Value = LedAcc
ThisFile = Range("A6").Value
NewBook.SaveAs Filename:=ThisFile
Workbooks(ThisFile & ".xlsx").Close SaveChanges:=False

End If

Next i

End Sub

Answer 1

我认为你的问题在这里：

Range(rRng, rRng2).Select

你可能意味着这样做：

Application.Union(rRng, rRng2).Select

在我的测试中

rRng是A1，A5，A8

rRng2是C1，C5，C8

Range(rRng, rRng2).Select 'results to select range("A1:C1")

Application.Union(rRng, rRng2).Select 'results to select cells A1,A5,A8,C1,C5,C8

Offtopic：

我建议您使用使用块，不要使用select但尝试引用范围而不选择它们：How to avoid using Select in Excel VBA macros

而不是

Workbooks("Test.xlsx").Sheets("TestBD").Select
Range(rRng, rRng2).Select
Selection.Copy

你可以做到

With Workbooks("Test.xlsx").Sheets("TestBD")
    .Range(rRng, rRng2).Copy
End With

或

Workbooks("Test.xlsx").Sheets("TestBD").Range(rRng, rRng2).Copy

无法从列表框中为多个项目执行宏

1 个答案: