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

帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

12^#

發表於 2016-3-25 14:21 | 只看該作者

回復 6# Hsieh

再次麻煩老師，因新增了一欄，功力不夠，無法達到效果，只好再以這個主題在有勞老師幫忙，附檔:

20160325.rar (24.77 KB)
新增F欄為TextBox3 所填入的資料，回車後，
當C欄產生B欄對應的資料後，就在那F欄填上TextBox3 的資料。

帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

11^#

發表於 2016-3-6 13:12 | 只看該作者

回復 9# 准提部林

也謝謝準大的幫忙解題回答，都一樣適用，第2項注意，給小弟在規劃工作表時，更多的細心事項，真多謝!
２．防錯是ＶＢＡ最重要的，建議〔出車〕與〔回車〕分別兩個按鈕執行，
　　否則若編號或姓名輸入一字之差，本來是回車變成出車！

帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

10^#

發表於 2016-3-6 13:07 | 只看該作者

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

回復 6# Hsieh

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

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-23

9^#

發表於 2016-3-6 11:57 | 只看該作者

〔出車〕〔回車〕分別處理：

Dim xChk&
　
Private Sub CommandButton1_Click()
xChk = 1: Call 記錄
End Sub
　
Private Sub CommandButton2_Click()
xChk = 2: Call 記錄
End Sub
　
Sub 記錄()
Dim xNo$, xName$, xR As Range
xNo = TextBox1: xName = TextBox2
If Not xNo Like "[A-Z]############" Then MsgBox "編號錯誤或未輸入!": Exit Sub
If xName = "" Then MsgBox "司機名未輸入!": Exit Sub
For Each xR In Range([A2], [A65536].End(xlUp))
　　If xR = xNo And xR(1, 2) = xName And xR(1, 3) = "" Then
　　　　If xChk = 1 Then MsgBox "本車次尚未回車，請確認!": Exit Sub
　　　　If xChk = 2 Then xR(1, 3) = xName: xR(1, 5) = Now: Exit Sub
　　End If
Next
If xChk = 1 Then [A65536].End(xlUp)(2).Resize(1, 4) = Array(xNo, xName, "", Now): Exit Sub
If xChk = 2 Then MsgBox "找不到本車次的出車記錄!": Exit Sub
End Sub

複製代碼

　
參考檔：

20160304_v1.rar (179.28 KB)

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-23

8^#

發表於 2016-3-6 11:30 | 只看該作者

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

１．最好在前面加入檢錯：
　　〔編號〕限制〔英大寫〕+數字１２碼
　　　If Not xNo Like "[A-Z]############" Then MsgBox "編號錯誤或未輸入!": Exit Sub
　　　If xName = "" Then MsgBox "司機名未輸入!": Exit Sub
２．防錯是ＶＢＡ最重要的，建議〔出車〕與〔回車〕分別兩個按鈕執行，
　　否則若編號或姓名輸入一字之差，本來是回車變成出車！

yen956

高中生 Rank: 3 Rank: 3

帖子: 522
主題: 36
精華: 1
積分: 603
點名: 0
作業系統: win xp sp3
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2012-12-13
最後登錄: 2021-7-11

7^#

發表於 2016-3-6 06:15 | 只看該作者

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

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 255
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-24

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2016-3-5 23:51 | 只看該作者

回復 5# man65boy

Private Sub CommandButton1_Click()
Dim A As Range
Set d = CreateObject("Scripting.Dictionary")
car = TextBox1 '車
man = TextBox2 '人
With Sheet2
For Each A In .Range(.[A2], .[A2].End(xlDown))
If car & man = A & A.Offset(, 1) Then d(A & A.Offset(, 1) & A.Offset(, 2)) = A.Offset(, 2).Address '找到車人
ad = d(A & A.Offset(, 1))
Next
If d(car & man) = "" Then '車人沒有則加列資料，否則填回車紀錄
Set A = .Cells(.Rows.Count, 1).End(xlUp)
A.Offset(1, 0) = car
A.Offset(1, 1) = man
Else
.Range(d(car & man)) = man
End If
End With
End Sub

複製代碼

學海無涯_不恥下問

帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

5^#

發表於 2016-3-5 23:15 | 只看該作者

回復 4# yen956

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

yen956

高中生 Rank: 3 Rank: 3

帖子: 522
主題: 36
精華: 1
積分: 603
點名: 0
作業系統: win xp sp3
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2012-12-13
最後登錄: 2021-7-11

4^#

發表於 2016-3-5 21:06 | 只看該作者

試試看:
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