2個條件的VBA

man65boy

如何在表單內輸入總表C欄"客戶名稱"裡的關鍵字，然後在ListBox1裡出現有關關鍵字裡的姓名，點選後，在ListBox2裡會出現符合姓名的歷史資料日期(總表B欄)，點選後，按確認，轉寫符合這2項的資料，在報價列印的B7:G30
依序往下排列。請教先進老師們不另指教!

20120530.rar (365.32 KB)

下載次數: 22

2012-5-31 23:52

GBKEE

回復 1# man65boy
ListBox1  更換為 ComboBox1
ListBox2 更換為  ComboBox2

1. Dim xlSh As Worksheet
   
2. Private Sub UserForm_Initialize()
   
3.     Set xlSh = Sheets("總表")
   
4.     TextBox1_Change              '
   
5. End Sub
   
6. Private Sub CommandButton1_Click()
   
7.     Dim Rng As Range, xi As Integer
   
8.     If ComboBox1.ListIndex > -1 And ComboBox2.ListIndex > -1 Then
   
9.         With xlSh
   
10.             xi = 2
    
11.             Do While .Cells(xi, "C") <> ""
    
12.                 If .Cells(xi, "B").Text = ComboBox2 And .Cells(xi, "C") = ComboBox1 Then
    
13.                     If Rng Is Nothing Then
    
14.                         Set Rng = .Range(.Cells(xi, "d"), .Cells(xi, "i"))
    
15.                     Else
    
16.                         Set Rng = Union(Rng, .Range(.Cells(xi, "d"), .Cells(xi, "i")))
    
17.                     End If
    
18.                 End If
    
19.                 xi = xi + 1
    
20.             Loop
    
21.             Rng.Copy
    
22.             Sheets("報價單列印").Cells(Rows.Count, "b").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
    
23.         End With
    
24.     Else
    
25.         MsgBox "客戶名稱  或 日期 ??? "
    
26.     End If
    
27. End Sub
    
28. Private Sub CommandButton2_Click()
    
29.     Unload UserForm1
    
30. End Sub
    
31. Private Sub TextBox1_Change()
    
32.     Dim xi As Integer, xlString As String
    
33.     With xlSh
    
34.         xi = 2
    
35.         Do While .Cells(xi, "C") <> ""
    
36.             If .Cells(xi, "C") Like "*" & TextBox1 & "*" Then
    
37.                 If InStr(xlString, "," & .Cells(xi, "C") & ",") = 0 Then
    
38.                     xlString = xlString & "," & .Cells(xi, "C") & ","
    
39.                 End If
    
40.             End If
    
41.             xi = xi + 1
    
42.         Loop
    
43.     End With
    
44.     If xlString = "" Then   'TextBox1的內容找不到
    
45.         ComboBox1.Clear
    
46.         ComboBox2.Clear
    
47.         Exit Sub
    
48.     End If
    
49.     With ComboBox1
    
50.         .List = Split(Mid(xlString, 2, Len(xlString) - 2), ",,")
    
51.         .Value = .List(0)
    
52.     End With
    
53. End Sub
    
54. Private Sub ComboBox1_Change()
    
55.     Dim xi As Integer, xlString As String
    
56.     If ComboBox1.ListIndex > -1 Then
    
57.     '控制項.ListIndex = -1    控制項的 值或選項 不在List內
    
58.         With xlSh
    
59.             xi = 2
    
60.             Do While .Cells(xi, "C") <> ""
    
61.                 If .Cells(xi, "C") = ComboBox1 Then
    
62.                     If InStr(xlString, "," & .Cells(xi, "B") & ",") = 0 Then
    
63.                         xlString = xlString & "," & .Cells(xi, "B") & ","
    
64.                     End If
    
65.                 End If
    
66.                 xi = xi + 1
    
67.             Loop
    
68.         End With
    
69.         With ComboBox2
    
70.             .List = Split(Mid(xlString, 2, Len(xlString) - 2), ",,")
    
71.             .Value = .List(0)
    
72.         End With
    
73.     ElseIf ComboBox1.ListIndex = -1 Then
    
74.         ComboBox2.Clear
    
75.     End If
    
76. End Sub

複製代碼

man65boy

回復 2# GBKEE


    感謝GBKEE大大的回答，查詢的地方，真得很好用，小弟不材再請GBKEE大大修改一下，轉寫前清除B7:G30，在轉寫資料到B7:G30，(不做重複的資料往下排列)，動作完成時不要有選取的動作殘留，麻煩請教導要如何修改，
    謝謝!!!

GBKEE

回復 3# man65boy
新增 CommandButton3

1. Private Sub CommandButton3_Click()
   
2.     Sheets("報價單列印").[B7:G30] = ""
   
3. End Sub

複製代碼

1. Rng.Copy
   
2.             Sheets("報價單列印").Cells(Rows.Count, "b").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
   
3.             Sheets("報價單列印").[B7].Select    '***加上這行程式碼

複製代碼

man65boy

回復 4# GBKEE

感謝GBKEE大大費心編寫，小弟得好好拜讀吸收，謝謝!

billyhsu

學習了,感謝