VBA宏 - 在Excel中使用列表框動態選擇列

我有一個excel文件，我所做的是將每個列標題作爲項目添加到列表框中。現在，我想要實現的是當我在列表框中選擇多個項目時，它將複製相應的列並將其粘貼到另一個工作簿。VBA宏 - 在Excel中使用列表框動態選擇列

我現在有這個代碼，它只能複製和粘貼我從列表框中選擇的第一列。我希望有人能幫助我。

Private Sub CommandButton1_Click() ' generate result 

Dim wkb As Workbook 
Dim rng As Range 
Dim cl As Object 
Dim strMatch As String 
Dim Size As Integer 
Dim lRow As Long, lCol As Long 
Dim rng1 As Range 
Dim rng2 As Range 
Dim rng3 As Range 

Set rng1 = Cells.Find("*", [a1], xlFormulas, , xlByRows, xlPrevious) 
Set rng2 = Cells.Find("*", [a1], xlFormulas, , xlByColumns, xlPrevious) 
Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column)) 

strMatch = ListBox2.List(0) 'Copying Respondent Number 
Set rng = Range("A1:Z1") 
For Each cl In rng 
    If cl.Value = strMatch Then 
     cl.EntireColumn.Copy 'Copy Selected Column 
     Set wkb = Workbooks.Add 'Adding New Workbook 
     ActiveSheet.Paste 'Paste Selected Column 
     Exit For 
    End If 
Next cl 

End Sub

來源

2016-09-05 alejandraux

，你的列表框LISTINDEX將在相關的worksheet.columns（指數） –

是@Nathan_Sav，我的正確。 – alejandraux

這是一個提示，不需要查找等，只需使用索引來建立你想要複製的列。 –

，你可以通過你的描述試試這個

Option Explicit 

Private Sub CommandButton1_Click() 
    Dim i As Long 
    Dim colsIndexStrng As String 
    Dim copyRng As Range 

    With Me.ListBox2 
     For i = 0 To .ListCount - 1 
      If .selected(i) Then colsIndexStrng = colsIndexStrng & Cells(1, i + 1).Address(False, False) & "," 
     Next i 
    End With 

    If colsIndexStrng = "" Then Exit Sub 

    Set copyRng = Range(Left(colsIndexStrng, Len(colsIndexStrng) - 1)).EntireColumn 
    With Workbooks.Add 
     copyRng.Copy ActiveSheet.Range("A1") 
    End With 
    ActiveWorkbook.Close True 
End Sub

來源

2016-09-05 17:28:31 user3598756

不客氣。那麼請將回答標記爲已接受。謝謝 – user3598756

謝謝你的heIp。我剛纔觀察到。此代碼工作正常，但它實際上並不複製我從列表框中選擇的列。我希望你能幫我找到一種方法來複制對應於我在列表框中選擇的項目的列。謝謝！ – alejandraux

我很抱歉我的錯誤。它已經運作。我只是改變我的列表樣式，它對我來說已經很好了。感謝您的大力幫助！你真的拯救了一天！ – alejandraux

建議更正。這將爲每個選定的列創建1個工作簿。

Private Sub CommandButton1_Click() ' generate result 
Dim rng As Range 
Dim cl As Object 
Dim strMatch As String 
Dim , i As Integer 
Dim lCol As Long 
lCol = Cells(1, Columns.Count).End(xlToLeft).Column 
For i = 0 To ListBox1.ListCount - 1 
strMatch = ListBox1.List(i) 'Copying Respondent Number 
Set rng = Range(Cells(1, 1), Cells(1, lCol)) 
Set cl = rng.Find(strMatch, lookat:=xlWhole) 
If Not cl Is Nothing Then 
     cl.EntireColumn.Copy 'Copy Selected Column 
     Set wkb = Workbooks.Add 'Adding New Workbook 
     ActiveSheet.Paste 'Paste Selected Column 
End If 
Next i 
End Sub

來源

2016-09-05 15:37:53 h2so4

我試過這段代碼，但是我收到一個錯誤，說「對象需要」。無論如何，感謝您的幫助 – alejandraux

@alejandraux我做了一些更正 – h2so4

VBA宏 - 在Excel中使用列表框動態選擇列

回答

相關問題