[發問] vba中listbox如何新增不連續之多欄資料

zming0304

各位好：
                我的工作表資料大概如下：(抱歉因資料涉及公司機密，資料被公司電腦鎖住，恕無法上傳檔案)
                標題1             標題2             標題3                        標題4                      標題5
                1399741      XXXXXXX      YYYYYYYYYYY      ZZZZZZZZZZ      WWWWWWW
                1213994      XXXXXX1      YYYYYYYYYY1      ZZZZZZZZZ1      WWWWWW1
                1234567      XXXXXX2      YYYYYYYYYY2      ZZZZZZZZZ2      WWWWWW2
                2345678      XXXXXX3      YYYYYYYYYY3      ZZZZZZZZZ3      WWWWWW3
                2139901      XXXXXX4      YYYYYYYYYY4      ZZZZZZZZZ4      WWWWWW4

我希望做到LISTBOXT可以依設定的條件如標題1中包含1399的資料在LISTBOX 依序加入如下：
                  標題1             標題2             標題3                        標題4                      標題5
                1399741      XXXXXXX      YYYYYYYYYYY      ZZZZZZZZZZ      WWWWWWW
                1213994      XXXXXX1      YYYYYYYYYY1      ZZZZZZZZZ1      WWWWWW1
                2139901      XXXXXX4      YYYYYYYYYY4      ZZZZZZZZZ4      WWWWWW4
想請問除了用自動篩選外，可以用LISTBOX,ADDITEM或是LISTBOX.LIST來完成嗎？
試了很多次，都只會覆蓋第一列資料，而無法依序新增，請各位高手幫幫忙，翻了五本相關VBA的書都寫
得不是很清楚，請各多多幫忙了，謝謝！

oobird

1. Private Sub UserForm_Initialize()
   
2.     Dim arr(), rng, i%, j%, m%
   
3.     Me.ListBox1.ColumnCount = 5
   
4.     Me.ListBox1.ColumnWidths = "60,60,60,60,60"
   
5. 
   
6.     rng = [a1].CurrentRegion
   
7.     For i = 1 To UBound(rng)
   
8.         If i = 1 Or rng(i, 1) Like "*1399*" Then
   
9.             m = m + 1
   
10.             ReDim Preserve arr(1 To 5, 1 To m)
    
11.             For j = 1 To 5
    
12.                 arr(j, m) = rng(i, j)
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     Me.ListBox1.List() = Application.Transpose(arr)
    
17. 
    
18. End Sub

複製代碼

GBKEE

回復 1# zming0304

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim E, i
   
4.     With ListBox1
   
5.         .Clear
   
6.         .ColumnCount = 5
   
7.         .ColumnWidths = "60,60,60,60,60"
   
8.         For Each E In Range("a1").CurrentRegion.Columns(1).Cells
   
9.             If InStr(E.Text, "139") Then
   
10.                 '.AddItem  E        '系統預設為ColumnCount = 1欄 要加入資料如此做就好
    
11.                 .AddItem            'ListBox1新增一列 : .ListCount -> ListBox1的列數
    
12.                 For i = 0 To 4     'ColumnCount >1 故須在新增列中每一欄依序加入數字文字
    
13.                     .List(.ListCount - 1, i) = E(1, i + 1)  'ListBox1的列從0開始
    
14.                 Next
    
15.             End If
    
16.         Next
    
17.     End With
    
18. End Sub

複製代碼

zming0304

回復  zming0304
GBKEE 發表於 2011-11-26 10:40

太厲害了，真的可以了，謝謝大大！

zming0304

回復 3# GBKEE
大大，可不可以再幫我一下，如果我是搜尋第二欄~第五欄的資料，
程式碼要如何修改才能讓新增的資料從第一欄開始寫入LISTBOX中，
For Each E In MYRNG
            If InStr(E.Text, CN) Then
                '.AddItem  E        '系統預設為ColumnCount = 1欄 要加入資料如此做就好
                LBMODEL.AddItem            'ListBox1新增一列 : .ListCount -> ListBox1的列數
                For j = -2 To 3
                J1 = (E.Offset(0, j))
                For i = 0 To 4   'ColumnCount >1 故須在新增列中每一欄依序加入數字文字
                LBMODEL.List(LBMODEL.ListCount - 1, i) = E(J1, i + 1) 'ListBox1的列從0開始
                Next
                Next
            ElseIf Left(E.Text, 4) > CN Then
                Exit For
            End If
          Next
我這樣改寫卻一直出現錯誤，請問問題出在那邊，再麻煩幫我偵錯一下，謝謝！

GBKEE

回復 5# zming0304

1. For Each E In MYRNG
   
2.             If InStr(E.Text, CN) Then
   
3.                 '.AddItem  E        '系統預設為ColumnCount = 1欄 要加入資料如此做就好
   
4.               ''****->刪掉  LBMODEL.AddItem            'ListBox1新增一列 : .ListCount -> ListBox1的列數  *****
   
5.                 For j = -2 To 3
   
6.                          LBMODEL.AddItem            ''依你的用意,  應是在這裡 新增一列
   
7.                        J1 = (E.Offset(0, j))
   
8.                       For i = 0 To 4   'ColumnCount >1 故須在新增列中每一欄依序加入數字文字
   
9.                 LBMODEL.List(LBMODEL.ListCount - 1, i) = E(J1, i + 1) 'ListBox1的列從0開始
   
10.                 Next
    
11.                 Next
    
12.             ElseIf Left(E.Text, 4) > CN Then
    
13.                 Exit For
    
14.             End If
    
15.           Next

複製代碼

zming0304

回復 6# GBKEE
For S = 1 To Workbooks("MODELNUM.xls").Sheets.Count
    Sheets(S).Activate
    Range(Cells(1, 1), Cells(65536, 5).End(xlUp)).Select
    Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlStroke, DataOption1:=xlSortNormal
    Sheets(S).Range(Cells(1, 1), Cells(1, 5)).Select
    CN = TBCHNM.Text
      Set CN1 = Cells.Find(CN, LOOKAT:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
      If Not CN1 Is Nothing Then
          'G = 1
          LBMODEL.ColumnCount = ActiveSheet.Columns.Count
          LBMODEL.ColumnWidths = "2cm;3.5cm;5cm;6.5cm;5cm"
          LBMODEL.Font.Size = 10
          LBMODEL.List = Range("A1:E1").Value
         
          Set MYRNG = Range(CN1, Range("C65536").End(xlUp))
          For Each E In MYRNG
            If InStr(E.Text, CN) Then
                '.AddItem  E        '系統預設為ColumnCount = 1欄 要加入資料如此做就好
                LBMODEL.AddItem            'ListBox1新增一列 : .ListCount -> ListBox1的列數
               
                For J = -2 To 3
               ' LBMODEL.AddItem
                For i = 0 To 4   'ColumnCount >1 故須在新增列中每一欄依序加入數字文字
                'LBMODEL.AddItem
                J1 = (E.Offset(0, J))
                LBMODEL.List(LT - 1, i) = J1 'ListBox1的列從0開始
                J = J + 1
                Next
                Next
             ElseIf Left(E.Text, Len(CN)) <> CN Then
                Exit For
            End If
          Next
      'ElseIf CN1 Is Nothing And G = 0 Then
        ' MsgBox "查無此料號"
      End If
Next
大大我把部分改寫成紅色部分就可以了，但又出現另外一個問題，就是我的資料表至少有三個，但我目前這樣寫，
程式跑出來的結果LISTBOX只保留最一個資料表搜尋到的結果，前二個資料表找到的結果統統被覆蓋了，這要如何修正呢？
再麻煩你教我一下，謝謝！

GBKEE

回復 7# zming0304
前二個資料表找到的結果統統被覆蓋了
LBMODEL.ColumnCount = ActiveSheet.Columns.Count  :  2003-> Columns.Count=256

1. With LBMODEL   '開頭這裡重設LBMODEL的內容
   
2.         .ColumnCount = ActiveSheet.Columns.Count
   
3.         .ColumnWidths = "2cm;3.5cm;5cm;6.5cm;5cm"
   
4.         .Font.Size = 10
   
5.         .Clear
   
6.     End With
   
7.     For S = 1 To Workbooks("MODELNUM.xls").Sheets.Count
   
8.         Sheets(S).Activate
   
9.         Set CN1 = Cells.Find(CN, LOOKAT:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
   
10.         If Not CN1 Is Nothing Then
    
11.           '
    
12.           'G = 1
    
13.           'LBMODEL.ColumnCount = ActiveSheet.Columns.Count
    
14.           'LBMODEL.ColumnWidths = "2cm;3.5cm;5cm;6.5cm;5cm"
    
15.           'LBMODEL.Font.Size = 10
    
16.           'LBMODEL.List = Range("A1:E1").Value   '<- 這裡會重設LBMODEL的內容
    
17.          
    
18.           '
    
19.           '
    
20.          
    
21.          'ElseIf CN1 Is Nothing And G = 0 Then
    
22.             ' MsgBox "查無此料號"
    
23.         End If
    
24.     Next
    
25. Next

複製代碼

zming0304

回復 8# GBKEE

了解，謝謝！