自动复制＆amp;根据ComboBox值粘贴特定列

Question

我一直在整理一个宏来读取 Sheet1 中的单元格并将它们放到 Sheet2 上的ComboBox上

此宏将所选单元格的列复制到 Sheet2 上的列。

到目前为止，我已经能够做到这一点，但它需要每次都引用每个单元格并运行宏。

一旦ComboBox值发生变化，我正在寻找列的自动更新，并且只使用一个'If语句'来复制和粘贴列。

到目前为止，这是我的代码：

Option Explicit

 Sub ComboBox1_Change()

 Dim cmbx As ComboBox
 Dim myRange As Range
 Dim i As Integer
 Dim c As Range

 Set cmbx = Sheet2.ComboBox1
 cmbx.Clear

 Set myRange = ActiveWorkbook.Sheets("Sheet1").Range("C4:I4")
 For Each c In myRange

   If c.Value <> "" Then
     cmbx.AddItem c.Value
     cmbx.ListIndex = 0
   End If

 Next

   If (cmbx.ListIndex = 0) Then
     With ActiveSheet
      .Range(.Range("D4"), .Range("D" & .Rows.Count)).Copy
     End With
    Sheets("Sheet2").Paste Destination:=Sheets("Sheet2").Range("B4")
   End If

   If (cmbx.ListIndex = 1) Then
     With ActiveSheet
      .Range(.Range("E4"), .Range("E" & .Rows.Count)).Copy
     End With
    Sheets("Sheet2").Paste Destination:=Sheets("Sheet2").Range("B4")
   End If

   If (cmbx.ListIndex = 2) Then
     With ActiveSheet
      .Range(.Range("F4"), .Range("F" & .Rows.Count)).Copy
     End With
    Sheets("Sheet2").Paste Destination:=Sheets("Sheet2").Range("B4")
   End If

   If (cmbx.ListIndex = 3) Then
     With ActiveSheet
      .Range(.Range("G4"), .Range("G" & .Rows.Count)).Copy
     End With
    Sheets("Sheet2").Paste Destination:=Sheets("Sheet2").Range("B4")
   End If

   If (cmbx.ListIndex = 4) Then
     With ActiveSheet
      .Range(.Range("H4"), .Range("H" & .Rows.Count)).Copy
     End With
    Sheets("Sheet2").Paste Destination:=Sheets("Sheet2").Range("B4")
   End If

   If (cmbx.ListIndex = 5) Then
     With ActiveSheet
      .Range(.Range("I4"), .Range("I" & .Rows.Count)).Copy
     End With
    Sheets("Sheet2").Paste Destination:=Sheets("Sheet2").Range("B4")
   End If

End Sub

编辑：

刚刚意识到此代码仅在ListIndex为0且 ListIndex 不是正确的函数时才有效。这适用于ComboBox中的第一项。还不确定需要改变什么。

---

感谢任何帮助。提前谢谢。

Answer 1

将如下所示的数据添加到Sheet1：

打开VBA编辑器/ IDE。创建userform1并拖放一个combobox1。

Private Sub UserForm_Initialize()
Dim cell As Range
    For Each cell In Worksheets("Sheet1").Range("A1:C1")
        Me.ComboBox1.AddItem (cell.Value)
    Next cell
End Sub

Private Sub ComboBox1_Change()
Select Case True
    Case ComboBox1.Text = "fruit"
        Worksheets("Sheet1").Range("A2:A100").Copy Worksheets("Sheet2").Range("A2")
    Case ComboBox1.Text = "vegetable"
        Worksheets("Sheet1").Range("B2:B100").Copy Worksheets("Sheet2").Range("A2")
    Case ComboBox1.Text = "tree"
        Worksheets("Sheet1").Range("C2:C100").Copy Worksheets("Sheet2").Range("A2")
End Select

End Sub

在VBA编辑器的Worksheet2下，添加

Private Sub Worksheet_Activate()
UserForm1.Show
End Sub

找到示例文件here。