返回列表 上一主題 發帖

VBA 當2個條件一樣時,自動尋找輸入

VBA 當2個條件一樣時,自動尋找輸入

在UserForm1裡,1.在車輛編號上輸入編號後,
2.司機人員又輸入人員編號後,自動依序轉寫UserForm1資料至A,B欄。

重點:假設工作表上A2已輸入A201603030001,B2已輸入黑松了,我再按輸入UserForm1裡頭,在同樣輸入車輛編號_A201603030001,司機人員_黑松時,C3要跑出B2的司機人員(黑松),就是要自動去尋找當2個條件一樣時,C欄顯現對應B欄的司機人員名字。

感謝老師幫忙解題!
附檔: 20160304.rar (178.74 KB)

本帖最後由 stillfish00 於 2016-3-4 16:55 編輯

回復 1# man65boy
同樣AB出現第二次以後,C欄就跟B欄一樣?
看不懂這樣C欄 司機人員(2) 的意義是啥。

還有你是要從UserForm輸入還是從工作表輸入
你敘述像是從UserForm,可是檔案是含Worksheet_Change(從工作表輸入)
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

本帖最後由 man65boy 於 2016-3-5 11:46 編輯

回復 2# stillfish00

回答stillfish00大大,是要從UserForm輸入的,輸入後按確定,轉寫資料到工作表的。
依序轉寫到工作表比較沒問題,困難的是當我再開啟UserForm輸入時,輸入的資料如果跟A.B欄一樣時,要在C欄產生和B欄一樣的資料(但不能把在UserForm輸入的資料轉寫),只能在C欄做處理,謝謝老師們費心!

TOP

試試看:
Private Sub CommandButton1_Click()
    Dim Lst As Integer, R As Integer
    Dim Rng As Range, MH
    Dim sh As Worksheet
    Set sh = Sheets("主頁")
    Lst = sh.[A65536].End(xlUp).Row        '取得"主頁"欄A 最下面非空白格的列號
   
    R = 1
    Set Rng = sh.Range("A2:A" & Lst)
    MH = Application.Match(TextBox1.Value, Rng, 0)
    If Not Application.IsNumber(MH) Then GoTo 101:     '如果TextBox1的資料不在A欄中→新增
    R = R + MH
    If Range("B" & R) = TextBox2.Value Then            '否則,比對TextBox2與B欄
'        If Range("C" & MH) <> "" Then GoTo 101:   '??如果C欄非空白格→要不要新增??
        Range("C" & R) = TextBox2.Value            '否則C欄為空白格→C欄=B欄
        Exit Sub                                   '即 司機人員(2)=司機人員(1)
    End If
   
    '重覆上列動作, 直到 R+1>Lst
    Do
        Set Rng = sh.Range("A" & R + 1 & ":A" & Lst)
        MH = Application.Match(TextBox1.Value, Rng, 0)
        If Not Application.IsNumber(MH) Then GoTo 101:
        R = R + MH
        If Range("B" & R) = TextBox2.Value Then
            Range("C" & R) = TextBox2.Value
            Exit Sub
        End If
    Loop Until R + 1 > Lst
101:
    '新增一列資料
    Range("A" & Lst + 1) = TextBox1.Value
    Range("B" & Lst + 1) = TextBox2.Value
End Sub

TOP

回復 4# yen956

謝謝yen956老師的回答,真的是太厲害了,剛剛試了幾回都沒甚麼問題,只剩下小弟表達還有不夠完善的地方,懇請老師在幫忙,例如:當工作表上有"車輛編號"A201603030015和"司機(1)"黑松和"司機(2)"黑松時,這代表他已經送貨回來了,但因為他在不同樣的時間又出去送貨,所以還要再次輸入"車輛編號"A201603030015和"司機(1)"黑松,這個資料還要依序在A欄和B欄上轉寫,當他又送貨完回來時,又要回到只能在C欄產生B欄對應的資料,麻煩老師在費心了,謝謝!

TOP

回復 5# man65boy
  1. Private Sub CommandButton1_Click()
  2. Dim A As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. car = TextBox1 '車
  5. man = TextBox2 '人
  6. With Sheet2
  7. For Each A In .Range(.[A2], .[A2].End(xlDown))
  8.   If car & man = A & A.Offset(, 1) Then d(A & A.Offset(, 1) & A.Offset(, 2)) = A.Offset(, 2).Address '找到車人
  9.   ad = d(A & A.Offset(, 1))
  10. Next
  11. If d(car & man) = "" Then '車人沒有則加列資料,否則填回車紀錄
  12. Set A = .Cells(.Rows.Count, 1).End(xlUp)
  13. A.Offset(1, 0) = car
  14. A.Offset(1, 1) = man
  15. Else
  16.   .Range(d(car & man)) = man
  17. End If
  18. End With
  19. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 5# man65boy
抱歉, 考慮久周, 迼成不便! 幸好有超版的救援!!

TOP

Private Sub CommandButton1_Click()
Dim xNo$, xName$, xR As Range
xNo = TextBox1: xName = TextBox2 
For Each xR In Range([A2], [A65536].End(xlUp))
  If xR = xNo And xR(1, 2) = xName And xR(1, 3) = "" Then
    xR(1, 3) = xName: xR(1, 5) = Now: Exit Sub
  End If
Next
[A65536].End(xlUp)(2).Resize(1, 4) = Array(xNo, xName, "", Now)
End Sub

1.最好在前面加入檢錯:
  〔編號〕限制〔英大寫〕+數字12碼
   If Not xNo Like "[A-Z]############" Then MsgBox "編號錯誤或未輸入!": Exit Sub
   If xName = "" Then MsgBox "司機名未輸入!": Exit Sub
2.防錯是VBA最重要的,建議〔出車〕與〔回車〕分別兩個按鈕執行,
  否則若編號或姓名輸入一字之差,本來是回車變成出車!
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

〔出車〕〔回車〕分別處理:
  1. Dim xChk&
  2.  
  3. Private Sub CommandButton1_Click()
  4. xChk = 1: Call 記錄
  5. End Sub
  6.  
  7. Private Sub CommandButton2_Click()
  8. xChk = 2: Call 記錄
  9. End Sub
  10.  
  11. Sub 記錄()
  12. Dim xNo$, xName$, xR As Range
  13. xNo = TextBox1: xName = TextBox2
  14. If Not xNo Like "[A-Z]############" Then MsgBox "編號錯誤或未輸入!": Exit Sub
  15. If xName = "" Then MsgBox "司機名未輸入!": Exit Sub
  16. For Each xR In Range([A2], [A65536].End(xlUp))
  17.   If xR = xNo And xR(1, 2) = xName And xR(1, 3) = "" Then
  18.     If xChk = 1 Then MsgBox "本車次尚未回車,請確認!": Exit Sub
  19.     If xChk = 2 Then xR(1, 3) = xName: xR(1, 5) = Now: Exit Sub
  20.   End If
  21. Next
  22. If xChk = 1 Then [A65536].End(xlUp)(2).Resize(1, 4) = Array(xNo, xName, "", Now): Exit Sub
  23. If xChk = 2 Then MsgBox "找不到本車次的出車記錄!": Exit Sub
  24. End Sub
複製代碼

 
參考檔:
20160304_v1.rar (179.28 KB)
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

本帖最後由 man65boy 於 2016-3-6 13:14 編輯

回復 6# Hsieh

謝謝Hsieh板大的回答,非常的適用,小弟會加以應用收藏,感恩在心!

TOP

        靜思自在 : 【行善要及時】行善要及時,功德要持續。如燒開水一般,未燒開之前千萬不要停熄火候,否則重來就太費事了。
返回列表 上一主題