iT邦幫忙

0

vba TextBox1比對資料

資料比對
c1203364 2021-05-06 11:23:29 ‧ 858 瀏覽

  • 分享至 

  • xImage

小弟我有亂拼湊掃描程式，目前卡在TextBox1 & TextBox2無法和B & C比對資料，想要TextBox1 & TextBox2掃出數值，會和B & C列比對，有重複的發出警告並自動返回TextBox1，謝謝大神

比對------------------
Dim WshShell, EE
    ActiveSheet.DisplayPageBreaks = False
  On Error Resume Next
s = TextBox1
For i = 2 To UsedRange.Rows.Count
If s = Cells(i, 2) Then GoTo EE
    If KeyCode = 13 Then
Exit For
 End If
 Next
EE: MsgBox WshShell.popup
Set WshShell = CreateObject("WScript.Shell")
EE = WshShell.popup(BtnCode, 1, "MsgBox " & s & "和B列第" & i & "行值重複。", 16)
    ActiveSheet.DisplayPageBreaks = True
掃描------------------
Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim WshShell, EE
  On Error Resume Next
        If KeyCode = 13 Then
        bcr = True
If Me.Controls("TextBox1") <> "" Then
If Me.Controls("TextBox1") = Me.Controls("TextBox2") Then GoTo EE
       Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 2) = TextBox1.Text
            Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 3) = TextBox2.Text
                   Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = Date
                ElseIf bcr = True Then
        bcr = False
        If KeyCode = 13 Then CommandButton1_Click
    Else
    End If
  For Each c In UserForm1.Controls
If TypeName(c) = "TextBox" Then c.Text = ""
            If KeyCode = 13 Then CommandButton1_Click
Next
Exit Sub
EE: MsgBox WshShell.popup
Set WshShell = CreateObject("WScript.Shell")
EE = WshShell.popup(BtnCode, 1, "重複", 16)
 Me.TextBox1.SetFocus
For Each c In UserForm1.Controls
If TypeName(c) = "TextBox" Then c.Text = ""
   If KeyCode = 13 Then CommandButton1_Click
Next
   End If
End Sub
Private Sub CommandButton1_Click()
  r = Len(Me.TextBox1.Text)
Me.TextBox1.SetFocus
Me.TextBox1.SelStart = 0
Me.TextBox1.SelLength = r
KeyCode = 13
TextBox1.Text = ""
  TextBox2.Text = ""
End Sub

檔案 https://www.sendspace.com/file/zg4vrb

登入發表討論
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

2 個回答

0
海綿寶寶
iT邦大神 1 級 ‧ 2021-05-06 11:28:22

https://ithelp.ithome.com.tw/upload/images/20210506/20001787LAveiHscqU.png

c1203364 iT邦新手 5 級 ‧ 2021-05-06 11:47:16 檢舉

謝謝提醒,感恩

登入發表回應
0
小魚
iT邦大師 1 級 ‧ 2021-05-06 12:47:29

不知道你的B跟C在哪,
TextBox取值裡面就有了,
Me.Controls("TextBox1") 這個就是了,
拿來比較就好了.

看更多先前的回應...收起先前的回應...
c1203364 iT邦新手 5 級 ‧ 2021-05-13 17:52:54 檢舉 
Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim WshShell, EE
   Dim intLen As Integer
  On Error Resume Next
       If KeyCode = 13 Then
If Len(Me.TextBox1.Text) And Len(Me.TextBox1.Text) <> 16 Then
Set WshShell = CreateObject("Wscript.Shell")
WshShell.popup "※字數不正確，請重新輸入！", 1, ""
Else
        If Me.Controls("TextBox1") <> "" Then
If Me.Controls("TextBox1") = Me.Controls("TextBox2") Then GoTo EE
        bcr = True
       Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 2) = TextBox1.Text
            Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 3) = TextBox2.Text
                   Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = Date
                ElseIf bcr = True Then
        bcr = False
    Else
    End If
        End If
        End If
            If KeyCode = 13 Then CommandButton1_Click
Exit Sub
EE: MsgBox WshShell.popup
Set WshShell = CreateObject("WScript.Shell")
EE = WshShell.popup(BtnCode, 1, "重複", 16)
   If KeyCode = 13 Then CommandButton1_Click
End Sub

Private Sub CommandButton1_Click()
  r = Len(Me.TextBox1.Text)
Me.TextBox1.SetFocus
Me.TextBox1.SelStart = 0
Me.TextBox1.SelLength = r
KeyCode = 13
TextBox1.Text = ""
  TextBox2.Text = ""
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r&, i&
If Target.Column = 2 And Target.Count = 1 Then
r = Target.Row
i = Application.CountIf(Range("B1:B" & r), Target.Value)
If i > 1 Then
Set WshShell = CreateObject("Wscript.Shell")
WshShell.popup Target.Value & "重複，請重新輸入！", 1, ""
End If
End If
If Target.Column = 3 And Target.Count = 1 Then
r = Target.Row
i = Application.CountIf(Range("C1:C" & r), Target.Value)
If i > 1 Then
Set WshShell = CreateObject("Wscript.Shell")
WshShell.popup Target.Value & "重複，請重新輸入！", 1, ""
End If
End If
      End Sub

已經拼湊完成了,但現在出現另個問題,就是掃描,記錄到欄位後,會出現重複的問題,應該是超過16碼的問題吧,請問有解嗎?謝謝

小魚 iT邦大師 1 級 ‧ 2021-05-13 18:29:46 檢舉

方便提供檔案嗎?

c1203364 iT邦新手 5 級 ‧ 2021-05-14 08:35:25 檢舉

檔案:https://www.sendspace.com/file/j0ss1w

小魚 iT邦大師 1 級 ‧ 2021-05-14 08:37:04 檢舉

恩恩,
我晚上回去再幫你看看.

c1203364 iT邦新手 5 級 ‧ 2021-05-14 09:19:55 檢舉

感恩

小魚 iT邦大師 1 級 ‧ 2021-05-15 07:49:01 檢舉

所以你的需求是甚麼?
我沒看到你在哪裡有做比對的動作...
另外...你的排版好亂...

c1203364 iT邦新手 5 級 ‧ 2021-05-17 09:37:55 檢舉

哈哈,因為我都是參考來的,拼拼湊湊的結果.....
原本的想法是在TextBox做比對,TextBox1 & TextBox2 重複、不記錄加警示,TextBox1 & TextBox2 和資料庫重複、不記錄加警示。
改到最後,TextBox1 & TextBox2 和資料庫重複,會記錄,然後需手動刪,以及超過16碼,尾2碼未進位前,會有重複警示

c1203364 iT邦新手 5 級 ‧ 2021-05-17 09:39:13 檢舉 
Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim WshShell, EE
   Dim intLen As Integer
  On Error Resume Next
       If KeyCode = 13 Then
If Len(Me.TextBox1.Text) And Len(Me.TextBox1.Text) <> 16 Then '固定16碼
Set WshShell = CreateObject("Wscript.Shell")
WshShell.popup "客戶字數不正確，請重新輸入！", 1, "", 64
Else
If Len(Me.TextBox1.Text) And Len(Me.TextBox2.Text) < 18 Then '18碼~24碼
Set WshShell = CreateObject("Wscript.Shell")
WshShell.popup "自家字數不正確，請重新輸入！", 1, "", 64
Else
        If Me.Controls("TextBox1") <> "" Then
If Me.Controls("TextBox1") = Me.Controls("TextBox2") Then GoTo EE
        bcr = True
       Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 2) = "S/N:" + TextBox1.Text  '直接加"S/N:" (目前先這樣解決)
            Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 3) = TextBox2.Text
                   Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = Date 'A欄加上今天日期
                ElseIf bcr = True Then
        bcr = False
    Else
    End If
        End If
        End If
           End If
            If KeyCode = 13 Then CommandButton1_Click
Exit Sub
EE: MsgBox WshShell.popup
Set WshShell = CreateObject("WScript.Shell")
EE = WshShell.popup(BtnCode, 1, "重複", 16)
   If KeyCode = 13 Then CommandButton1_Click
End Sub
Private Sub CommandButton1_Click()
  r = Len(Me.TextBox1.Text)
Me.TextBox1.SetFocus
Me.TextBox1.SelStart = 0
Me.TextBox1.SelLength = r
KeyCode = 13
TextBox1.Text = ""
  TextBox2.Text = ""
End Sub




Private Sub Worksheet_Change(ByVal Target As Range)
Dim r&, i&
If Target.Column = 2 And Target.Count = 1 Then
r = Target.Row
i = Application.CountIf(Range("B1:B" & r), Target.Value)
If i > 1 Then
Set WshShell = CreateObject("Wscript.Shell")
WshShell.popup Target.Value & "重複，請重新輸入！", 1, "", 64
End If
End If
If Target.Column = 3 And Target.Count = 1 Then
r = Target.Row
i = Application.CountIf(Range("C1:C" & r), Target.Value)
If i > 1 Then
Set WshShell = CreateObject("Wscript.Shell")
WshShell.popup Target.Value & "重複，請重新輸入！", 1, "", 64
End If
End If
Range("A" & Rows.Count).End(xlUp).Select
      End Sub
小魚 iT邦大師 1 級 ‧ 2021-05-17 12:42:21 檢舉

不過現在還沒加入資料庫的部分吧,
那可能要查一下相關資料..

登入發表回應

我要發表回答

立即登入回答
iThome鐵人賽
參賽組數
1064 組
團體組數
40 組
累計文章數
22203 篇
完賽人數
602 人
iT+看影片追技術 看影片追技術 看更多
熱門tag 看更多
15th鐵人賽 16th鐵人賽 13th鐵人賽 14th鐵人賽 12th鐵人賽 11th鐵人賽 鐵人賽 2019鐵人賽 javascript 2018鐵人賽 python 2017鐵人賽 windows php c# windows server linux css react vue.js
熱門問題
熱門回答
熱門文章
IT邦幫忙