Board logo

標題: VBA 當2個條件一樣時,自動尋找輸入 3 程式修改 [打印本頁]

作者: man65boy    時間: 2018-11-28 13:14     標題: VBA 當2個條件一樣時,自動尋找輸入 3 程式修改

基本使用UserForm1輸入資料沒甚麼問題,但資料轉寫到工作表上的後,在經過刪除,會無法在刪除後欄位上做UserForm1的資料的轉寫,會把資料做跳到下一列的動作,請老師們幫忙修改,謝謝!
附檔:[attach]29748[/attach]
作者: Kubi    時間: 2018-11-29 20:20

回復 1# man65boy
每當開啟檔案會透過ThisWorkbook的Open事件記錄兩個字典物件資料,此時執行輸入按鈕會正常寫入主頁工作表中。
但是當你以手動去刪除主頁中的資料,lRows&及兩個字典檔 vDIO & vDPeo 此時並沒有同步更新成你刪除後的資料,
亦即它會保存你還未刪除前的資料,這會讓lRows、vDIO、vDPeo的資料內容失真。
如再次執行輸入按鈕時會以字典檔中的舊資料來比對,如此就會產生無法預期的結果。

我並沒有去實際了解你程式運作方式,不過大方向來講應可透過下列方式予以改善:
1.將ThisWorkbook的Open事件內所有程式碼,移往UserForm1的Initialize事件程序中,同時將ThisWorkbook模組內的Open事件全部清空。
2.將Module1模組內的所有全域型公用變數移往UserForm1模組內的上端,並將之前宣告的Public改為Dim lRows&、Dim vDIO、Dim vDPeo,
因為此3個變數的生命週期只須存在此UserForm1模組中即可,完成後再將Module1模組內所宣告的公用變數全數清除。

以上淺見供參
作者: man65boy    時間: 2018-11-30 09:54

回復 2# Kubi

謝謝大大的熱心回答,小弟功力尚淺,無法透徹理解,更改過後程式是無法運行的(有不正確的屬性),請老師再次幫忙,謝謝你!
作者: 准提部林    時間: 2018-12-1 11:49

在工作表表格直接輸入及操作不是更方便???
用表單覺得反而礙手~~
作者: man65boy    時間: 2018-12-3 10:17

回復 4# 准提部林

回準大的話,表單最高一天有近千筆的資料,有些早上輸入後,晚上7點多才回報時間結束,所以在資料很多還沒結束時,以前都是用"尋找"功能,想說使用表單是配合公司採用條碼機輸入,所以使用上,會比工作表輸入還要來的快,這個問題在http://forum.twbts.com/thread-16895-1-1.html   VBA 當2個條件一樣時,自動尋找輸入 2  有老師們以幫小弟解決了這項表單的製作,只是最近發現出小問題點改善,請大大幫忙,謝謝!
作者: Kubi    時間: 2018-12-3 21:58

回復 3# man65boy
請參考
[attach]29763[/attach]
作者: man65boy    時間: 2018-12-4 11:16

回復 6# Kubi

謝謝Kubi大大的回覆,但 下戴後無法開啟,檔案損毀。。。。。
作者: Kubi    時間: 2018-12-5 21:07

回復 7# man65boy
請將底下UserForm1模組內的所有程式碼複製並貼入你的UserForm1模組內

Dim lRows&
Dim vDIO, vDPeo

Private Sub CommandButton1_Click()
  Dim lRow&
  
  If TextBox1 = "" Then
    MsgBox "你必須輸入 (車輛編號)"
    Exit Sub
  End If
  
  If TextBox2 = "" Then
    MsgBox "你必須輸入 (司機人員)"
    Exit Sub
  End If
  
  lRow = vDPeo(CStr(TextBox1 & "-" & TextBox2))
  If vDIO(CStr(TextBox1 & "-" & TextBox2)) = "O" Then ' 回來了
    Cells(lRow, 3) = TextBox2
    Cells(lRow, 5) = Now
    Cells(lRow, 6) = ComboBox1.Text
    vDIO(CStr(TextBox1 & "-" & TextBox2)) = "I"
  Else ' 即將外出
    lRows = lRows + 1
    Cells(lRows, 1) = TextBox1
    Cells(lRows, 2) = TextBox2
    Cells(lRows, 4) = Now
    vDIO(CStr(TextBox1 & "-" & TextBox2)) = "O"
    vDPeo(CStr(TextBox1 & "-" & TextBox2)) = lRows
  End If
End Sub

Private Sub UserForm_Initialize()
  
  Dim lRow&
  Dim sStr$
  
  Set vDIO = CreateObject("Scripting.Dictionary")
  Set vDPeo = CreateObject("Scripting.Dictionary")
  lRow = 2
  While Cells(lRow, 1) <> ""
    If Cells(lRow, 3) = "" Then
      sStr = "O"
    Else
      sStr = "I"
    End If
    vDIO(CStr(Cells(lRow, 1) & "-" & Cells(lRow, 2))) = sStr
    vDPeo(CStr(Cells(lRow, 1) & "-" & Cells(lRow, 2))) = lRow
    lRow = lRow + 1
  Wend
    lRows = lRow - 1
  
  
  ComboBox1.AddItem "NO"
  ComboBox1.AddItem "Yes"
  ComboBox1.ListIndex = 0
End Sub

之後再將Module1及ThisWorkbook兩個模組內的資料全部刪除後執行看看。
作者: man65boy    時間: 2018-12-6 10:02

回復 8# Kubi


    謝謝老師的回答,程式執行後,發現有一個問題,就是把其中一列刪除後,再利用表單執行寫入時,資料是會把之前刪除的那一列填滿,但 如果表單一直寫入,程式會把刪除後的那一列以下列位的文字覆蓋過去,懇請老師幫忙解題,謝謝老師。.
附檔:[attach]29771[/attach]
作者: 准提部林    時間: 2018-12-6 15:41

車輛編號 及 司機人員 的組合都固定不重覆???

試試~~
Dim vD As Object

Private Sub CommandButton1_Click()
Dim T$, T1$, T2$, R&
T1 = TextBox1:   T2 = TextBox2:   T = T1 & "|" & T2
If T1 = "" Then MsgBox "你必須輸入 (車輛編號)  ": Exit Sub
If T2 = "" Then MsgBox "你必須輸入 (司機人員)  ": Exit Sub
R = Val(vD(T))
If R = 0 Then MsgBox "車輛/司機:" & T1 & "/" & T2 & ",這組合不存在 ": Exit Sub
If R < 0 Then '出車
   Cells(-R, 3).Resize(1, 4) = ""
   Cells(-R, 4) = Now: ComboBox1.Text = ""
   vD(T) = -R
Else '回車
  If ComboBox1.Text = "" Then MsgBox "這是【回車】趟,(回車物品) 必須輸入 ": Exit Sub
  Cells(R, 3) = T2:   Cells(R, 5) = Now:   Cells(R, 6) = ComboBox1.Text
  vD(T) = -R
End If
End Sub

Private Sub UserForm_Initialize()
Dim T$, T1$, T2$, i&
Set vD = CreateObject("Scripting.Dictionary")
Arr = Range([F1], [A65536].End(xlUp))
For i = 2 To UBound(Arr)
    T1 = Arr(i, 1):   T2 = Arr(i, 2):   T = T1 & "|" & T2
    If T1 = "" Or T2 = "" Then GoTo 101
    vD(T) = i
    If Arr(i, 4) = "" Or Arr(i, 5) <> "" Then vD(T) = -i
101: Next i
ComboBox1.List = Array("NO", "Yes")
End Sub

[attach]29774[/attach]
作者: man65boy    時間: 2018-12-6 16:44

回復 10# 准提部林


    謝准大大的回答,程式執行只有尋找(寫入返回車)的功能,沒原先的寫入(增加車輛編號&出車)的功能,我把名稱改一下,會比較理解,不然小弟會誤導老師們,拍事!
表單設計功能是,配合公司條碼機,能快速寫入,尋找,計算時間,工作表A欄(車輛編號)<<是英文+數字不固定的,B欄(出車人員(1))<<也是是英文+數字不固定的,C欄(返車人員(2))<<也是是英文+數字不固定的,最重要的是B.C欄相同一列的人員號碼,絕對是一樣的,意思是使用表單輸入寫入,當車輛編號輸入11,司機人員輸入王建民,表單中的(回車物品)在出車人員成立時,是無法寫入的,按確定,資料完全寫入,然後,我再次使用表單輸入,當車輛編號再次輸入11,司機人員再次輸入王建民時,表單就要去尋找工作表裡,哪個欄位是11,哪個返車人員是王建民,找到後寫入,表單中的(回車物品)在返車人員成立時,是可以寫入的,所有的資料都依序往下寫入,假使途中把工作表內的資料其中一列,刪除時,再次使用表單輸入時,也要把新的資料,填補在那一列,如再有新資料,也要往下列輸入,(字太多,有點灰),有勞老師幫忙。
[attach]29775[/attach]
作者: 准提部林    時間: 2018-12-6 17:27

本帖最後由 准提部林 於 2018-12-6 17:32 編輯

回復 11# man65boy


1) 假使途中把工作表內的資料其中一列,刪除時,再次使用表單輸入時,也要把新的資料,填補在那一列
   __是指[清除]吧! 列變成空白, 而不是整列刪除???
  __所以, 新的資料要從中間有空白的列優先填補, 沒有中間空白列了, 才從最後一列下面空白列填寫???
  __要新寫入的資料與被刪除的沒有對應關係???
2) 己有[回車]時間的列, 不再對其做任何處理???  (表示該工作已完成)
3) 只有[出車]時間者, 等[回車]時, 只要填入__人員(2)/回車時間/物品???
4) 新增[出車]時, 只填入__車輛/人員(1)/出車時間???
作者: 准提部林    時間: 2018-12-6 20:18

回復 11# man65boy

Dim vD As Object

Private Sub CommandButton1_Click()
Dim T$, T1$, T2$, R&
T1 = TextBox1:   T2 = TextBox2:   T = T1 & "|" & T2
If T1 = "" Then MsgBox "你必須輸入 (車輛編號)  ": Exit Sub
If T2 = "" Then MsgBox "你必須輸入 (司機人員)  ": Exit Sub
R = Val(vD(T))
If R = 0 Then '出車
   R = [A:A].Find(What:="", LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Row
   Cells(R, 1) = T1: Cells(R, 2) = T2:  Cells(R, 4) = Now
   vD(T) = R
Else '回車
  If ComboBox1.Text = "" Then MsgBox "這是【回車】趟,(回車物品) 必須輸入 ": Exit Sub
  Cells(R, 3) = T2:   Cells(R, 5) = Now:   Cells(R, 6) = ComboBox1.Text
  vD(T) = 0
End If
TextBox1 = "": TextBox1.SetFocus: TextBox2 = "": ComboBox1 = ""
End Sub

Private Sub UserForm_Initialize()
Dim T$, T1$, T2$, i&, Arr
Set vD = CreateObject("Scripting.Dictionary")
Arr = Range([F1], [A65536].End(xlUp))
For i = 2 To UBound(Arr)
    T1 = Arr(i, 1):   T2 = Arr(i, 2):   T = T1 & "|" & T2
    If T1 <> "" And T2 <> "" And Arr(i, 3) = "" Then vD(T) = i
Next i
ComboBox1.List = Array("NO", "Yes")
End Sub

[attach]29776[/attach]
作者: man65boy    時間: 2018-12-6 22:57

回復 13# 准提部林
謝謝准大老師的幫忙,完美的工作表,真是太實用了,謝謝准大老師。
准大的名言:
<准提部林>知識+.點數有多有少.公仔換不了.慈善捐不了.門票抵不了多了富不了.少了死不了.機心追累何時了知識+.頭銜有高有低.名片印不了.招牌掛不了.墓誌刻不了高了傲不了.低了羞不了.苦心謀取何時了  ============================ 滴水效應
作者: n7822123    時間: 2018-12-6 23:53

本帖最後由 n7822123 於 2018-12-7 00:04 編輯

回復 1# man65boy

你的程式寫的好分散.......
你原本的程式只要改其中一行即可
討論串好長......懶得看,好像還有其他問題
只解決你1樓的問題,不幫助其他Debug

lRows =  lRows+ 1
改為
lRows = [A1].End(4).Row + 1

[attach]29777[/attach]




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