無法爲列表框中的多個項目執行宏

Question

我是新手。我剛剛寫了一個代碼，通過查看這些單元格的左側相鄰列中數字的前3個數字來複制一系列單元格。例如：如果A1和A5的前三個數字是100，則複製B1：D1和B5：D5到新工作簿。在開始時，我使用inputbox輸入數字（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：

讓我推薦你使用隨着塊，不使用選擇，但儘量參考範圍，而不選擇它們：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