返回列表 上一主題 發帖

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

zming0304

帖子
5 
主題
1 
精華
0 
積分
11 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
男 
註冊時間
2011-11-25 
最後登錄
2016-12-21 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-11-26 01:12 | 只看該作者

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

各位好：
                我的工作表資料大概如下：(抱歉因資料涉及公司機密，資料被公司電腦鎖住，恕無法上傳檔案)
                標題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
　頭銜: 街友一族

超級版主Rank: 8Rank: 8

帖子
1572 
主題
16 
精華
2 
積分
1521 
點名
0  
作業系統
xp 
軟體版本
office 2003 
閱讀權限
150 
性別
男 
註冊時間
2010-5-1 
最後登錄
2016-1-13 

論壇貢獻勳章
2#
發表於 2011-11-26 08:34 | 只看該作者
  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"

  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)

  18. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2011-11-26 10:40 | 只看該作者
回復 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
複製代碼

TOP

zming0304

帖子
5 
主題
1 
精華
0 
積分
11 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
男 
註冊時間
2011-11-25 
最後登錄
2016-12-21 
4#
發表於 2011-11-26 15:21 | 只看該作者

RE: vba中listbox如何新增不連續之多欄資料

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


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

TOP

zming0304

帖子
5 
主題
1 
精華
0 
積分
11 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
男 
註冊時間
2011-11-25 
最後登錄
2016-12-21 
5#
發表於 2011-11-28 17:03 | 只看該作者
回復 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
我這樣改寫卻一直出現錯誤，請問問題出在那邊，再麻煩幫我偵錯一下，謝謝！

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2011-11-28 17:08 | 只看該作者
本帖最後由 GBKEE 於 2011-11-28 17:27 編輯

回復 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
複製代碼

TOP

zming0304

帖子
5 
主題
1 
精華
0 
積分
11 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
男 
註冊時間
2011-11-25 
最後登錄
2016-12-21 
7#
發表於 2011-11-29 11:12 | 只看該作者
回復 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只保留最一個資料表搜尋到的結果，前二個資料表找到的結果統統被覆蓋了，這要如何修正呢？
再麻煩你教我一下，謝謝！

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2011-11-29 11:37 | 只看該作者
本帖最後由 GBKEE 於 2011-11-29 13:31 編輯

回復 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
複製代碼

TOP

zming0304

帖子
5 
主題
1 
精華
0 
積分
11 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
男 
註冊時間
2011-11-25 
最後登錄
2016-12-21 
9#
發表於 2011-11-29 12:05 | 只看該作者
回復 8# GBKEE

了解，謝謝！

TOP

        靜思自在 : 時時好心就是時時好日。
返回列表 上一主題