Board logo

標題: 2個條件的VBA [打印本頁]
作者: man65boy    時間: 2012-5-31 23:53     標題: 2個條件的VBA

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

[attach]11207[/attach]
作者: GBKEE    時間: 2012-6-1 09:03

回復 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    時間: 2012-6-1 20:43

回復 2# GBKEE


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

回復 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    時間: 2012-6-1 23:26

回復 4# GBKEE

感謝GBKEE大大費心編寫，小弟得好好拜讀吸收，謝謝!
作者: billyhsu    時間: 2013-8-30 14:36

學習了,感謝



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)