GBKEE

回復 4# yliu

1. Private Sub CommandButton1_Click()
   
2.     Dim rowcnt&, rowcnt_login&
   
3.     Dim g As Integer, 序號 As Range, I As Integer
   
4.     Set 序號 = Sheets("login").[B9:J19]                             '物件 : 設定複製的範圍
   
5.     g = Application.CountA(Sheets("final").[A:A]) + 1               '讀取A欗有資料數的儲存格數 +1
   
6.     I = 1
   
7.     Do Until 序號.Range("A" & I) = "" Or I > 序號.Rows.Count
   
8.          '範圍 的 Range("A" & I)->範圍的"A"欗  ,Rows.Count;範圍列數的計算
   
9.         With Sheets("final")
   
10.             .Cells(g, "A") = Sheets("login").ComboBox1.Value
    
11.             .Cells(g, "B").Resize(1, 序號.Columns.Count) = 序號.Rows(I).Value
    
12.             g = g + 1
    
13.             I = I + 1
    
14.         End With
    
15.     Loop
    
16. End Sub

複製代碼

GBKEE

回復 6# yliu

1. Private Sub CommandButton1_Click()
   
2.     Dim g As Integer, E As Range
   
3.     g = Application.CountA(Sheets("final").[A:A]) + 1               '讀取A欗有資料數的儲存格數 +1
   
4.     For Each E In Sheets("login").[B9:B19]
   
5.         If E = "" Then Exit For
   
6.         With Sheets("final")
   
7.             .Cells(g, "A") = Sheets("login").ComboBox1.Value
   
8.             .Cells(g, "B").Resize(1, 2) = E.Resize(1, 2).Value
   
9.             .Cells(g, "D").Resize(1, 6) = E.Cells(1, 4).Resize(1, 6).Value
   
10.         End With
    
11.         g = g + 1
    
12.     Next
    
13. End Sub

複製代碼

GBKEE

回復 9# yliu

1. Private Sub CommandButton1_Click()
   
2.     Dim g As Integer, E As Range, C As Range, 單號 As String, SS As String, Rng As Range
   
3.     Dim i As Integer
   
4.     With Sheets("login")
   
5.         單號 = .ComboBox1.Value
   
6.         Set Rng = .[B9:B19]
   
7.         SS = Application.Phonetic(Rng)                                                  '結合所有序號
   
8.     End With
   
9.    
   
10.     With Sheets("final").[A:A]
    
11.         If Application.CountIf(.Cells, 單號) > 1 Then
    
12.             .Replace 單號, "=xxx", xlWhole                                               ''Replace 方法
    
13.             With .SpecialCells(xlCellTypeFormulas, xlErrors)
    
14.                 .Cells = 單號
    
15.                 For Each C In .Cells                                                     ''比對到 序號 踢除 此序號
    
16.                     If InStr(SS, C.Offset(, 1)) Then SS = Replace(SS, C.Offset(, 1), "") 'Replace 函數
    
17.                     If SS = "" Then Exit Sub
    
18.                 Next
    
19.             End With
    
20.         End If
    
21.         For Each E In Rng
    
22.             If E = "" Then Exit For
    
23.             If InStr(SS, E) Then                                              '比對到 序號
    
24.                 g = Application.CountA(.Cells) + 1                            '讀取A欗有資料數的儲存格數 +1
    
25.                 i = Application.CountA(Rng)
    
26.                 .Cells(g, "A").Resize(1) = 單號
    
27.                 .Cells(g, "B").Resize(1, 2) = E.Cells(1).Resize(1, 2).Value
    
28.                 .Cells(g, "D").Resize(1, 6) = E.Cells(1, 4).Resize(1, 6).Value
    
29.             End If
    
30.         Next
    
31.     End With
    
32. End Sub

複製代碼

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

複製代碼

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