請教各位大神,想做一個掃描槍的程式,如下
1.2個TextBox對應A列和B列(掃完自動放到A列B列)
2.重複自動刪除,例如掃描到2個一樣的,就不會跳到下一個TextBox
3.需要迴圈
目前"相同號碼刪除"的觸發不了,卡住了,幫幫忙,謝謝
Dim AR()
Private Sub UserForm_Initialize()
AR = Array(TextBox1, TextBox2)
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
With [A65536].End(xlUp).Cells(2, 1).Resize(1, UBound(AR) + 1)
.Value = AR
.Value = .Value
End With


相同號碼刪除
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count <> 1 Then Exit Sub
Dim sh1 As Worksheet
Set sh1 = Target.Worksheet
Dim tempvalue As String
tempvalue = Target.Value
Dim F As WorksheetFunction
Set F = WorksheetFunction
If F.CountIf(sh1.UsedRange, tempvalue) > 1 Then
Target = ""
Target.Select
End If
End Sub

[點擊下載]
文章關鍵字
Dim bcr As Boolean
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 TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
bcr = True
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = TextBox1.Text
ElseIf bcr = True Then
bcr = False
Else
End If
End Sub
Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
bcr = True
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 0, 2) = TextBox2.Text
ElseIf bcr = True Then
bcr = False
Else
End If
If KeyCode = 13 Then CommandButton1_Click
End Sub

改成這樣好像比較好,但TextBox1和TextBox2如果跟a列或b列重複,有辦法不能往下跑嗎?求大神,謝謝
文章分享
評分
評分
複製連結

今日熱門文章 網友點擊推薦!