c_c_lai

回復 20# yliu
如果妳將 MultiSelect:  - fmMultiSelectSingle 改成  fmMultiSelectMulti
如此 ListBox2 對應之 ListBox2_Change() 則將無任何作用，
是故你必須使用另外的方式來處理妳的勾選項，反之、
在每次勾選時都會觸動  ListBox2_Change() 。

GBKEE

回復 12# yliu

1. Private Sub ListBox2_Change()
   
2.     Dim lrow, irow, ai As Integer, AR, S As String
   
3.     With ListBox1
   
4.         AR = .List  '.List-> ( 0 TO .ListCount - 1, 0 TO  9)   ListBox的ColumnCount 屬性 最多只能有 10 行 (0 到 9)。
   
5.                     '這ListBox1只有4行資料,後面的5行-9行 = Null,使用Index 函數會錯誤
   
6.         If .ListCount > 0 Then ReDim Preserve AR(0 To .ListCount - 1, 0 To .ColumnCount - 1)   '消除 後面的5行-9行的 Null
   
7.         For lrow = 0 To .ListCount - 1
   
8.             If .Selected(lrow) Then
   
9.                 S = S & Join(Application.Index(AR, lrow + IIf(UBound(AR) = 0, 0, 1)), "")       '紀錄已勾選的資料
   
10.             End If
    
11.         Next
    
12.         .Clear
    
13.     End With
    
14.     [A9:E19] = ""
    
15.     With ListBox2
    
16.         For lrow = 0 To .ListCount - 1
    
17.             If .Selected(lrow) Then
    
18.                 With Sheets(Sh)
    
19.                     ai = 2
    
20.                     Do While .Cells(ai, "A") <> ""
    
21.                         If .Cells(ai, "A") = ListBox2.List(lrow, 0) Then
    
22.                             With ListBox1
    
23.                                 .AddItem
    
24.                                 irow = .ListCount
    
25.                                 .List(irow - 1, 0) = Sheets(Sh).Cells(ai, "A")
    
26.                                 .List(irow - 1, 1) = Sheets(Sh).Cells(ai, "B")
    
27.                                 .List(irow - 1, 2) = Sheets(Sh).Cells(ai, "C")
    
28.                                 .List(irow - 1, 3) = Sheets(Sh).Cells(ai, "D")
    
29.                                 .List(irow - 1, 4) = Sheets(Sh).Cells(ai, "E")
    
30.                                 If InStr(S, Application.Phonetic(Sheets(Sh).Cells(ai, "A").Resize(, 5))) Then '比對: 紀錄已勾選的資料
    
31.                                     .Selected(.ListCount - 1) = True
    
32.                                 End If
    
33.                             End With
    
34.                         End If
    
35.                         ai = ai + 1
    
36.                     Loop
    
37.                 End With
    
38.             End If
    
39.         Next
    
40.     End With
    
41. End Sub

複製代碼

yliu

回復 22# GBKEE
GBKEE版大,
出現型態不符的錯誤訊息, 在AR = .List '.List-> ( 0 TO .ListCount - 1, 0 TO  9)   ListBox的ColumnCount 屬性 最多只能有 10 行 (0 到 9)。

GBKEE

回復 23# yliu
請修改如下
Dim lrow, irow, ai As Integer, AR(), S As String -> Dim  AR
If UBound(AR) > -1 Then ReDim    ->  If .ListCount > 0 Then ReDim

yliu

回復 24# GBKEE
感謝GBKEE, 改善原程式碼的缺點. 謝謝你的幫忙.