(giúp đỡ ạ) dùng hàm lấy giá trị từ cột vba không hoạt động

[namdajka97x]

Minh có sheet1 data sẵn có các giá trị
sheet 2 nhập dữ liệu
cột A sheet2 minh dùng hàm left lấy 4 kí tự để so sanh các giá trị sheet 1 nếu không có msgbox sẽ báo "mà này không tồn tại"
Minh đang gặp kho khăn như tiêu đề ạ.
E xin cảm ơn ạ. !

Bài đã được tự động gộp: 9/4/20

nhập tay trực tiếp thì vba hoạt động ạ

 

[SA_DQ]

Chạy macro này thử xem có khác gì chăng:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, sRng As Range
   
With Target
      If .Column = 1 And .Row >= 2 Then
         Set Rng = Sheet1.Range("A1:A5000")
         Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
         If sRng Is Nothing Then
            MsgBox "không có mă này"
            Target.Value = Empty
            Sheet2.Range("B65536").End(xlUp).Offset(1).Select
            MsgBox Selection.Address
        Else
            MsgBox "Sao?", , Target.Address
         End If
      End If
End With
End Sub

 

[namdajka97x]

Chạy macro này thử xem có khác gì chăng:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, sRng As Range
  
With Target
      If .Column = 1 And .Row >= 2 Then
         Set Rng = Sheet1.Range("A1:A5000")
         Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
         If sRng Is Nothing Then
            MsgBox "không có mă này"
            Target.Value = Empty
            Sheet2.Range("B65536").End(xlUp).Offset(1).Select
            MsgBox Selection.Address
        Else
            MsgBox "Sao?", , Target.Address
         End If
      End If
End With
End Sub

KHÔNG ĐC BÁC Ạ

Bài đã được tự động gộp: 9/4/20

Chạy macro này thử xem có khác gì chăng:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, sRng As Range
  
With Target
      If .Column = 1 And .Row >= 2 Then
         Set Rng = Sheet1.Range("A1:A5000")
         Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
         If sRng Is Nothing Then
            MsgBox "không có mă này"
            Target.Value = Empty
            Sheet2.Range("B65536").End(xlUp).Offset(1).Select
            MsgBox Selection.Address
        Else
            MsgBox "Sao?", , Target.Address
         End If
      End If
End With
End Sub

ý e muốn nhập ô B còn check mã có tồn tại ô A ạ

 

[namdajka97x]

buồn quá

 

[HieuCD]

Minh có sheet1 data sẵn có các giá trị
sheet 2 nhập dữ liệu
cột A sheet2 minh dùng hàm left lấy 4 kí tự để so sanh các giá trị sheet 1 nếu không có msgbox sẽ báo "mà này không tồn tại"
Minh đang gặp kho khăn như tiêu đề ạ.
E xin cảm ơn ạ. !

Bài đã được tự động gộp: 9/4/20

nhập tay trực tiếp thì vba hoạt động ạ

Phải bắt sự kiện cột "B"

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rng As Range, sRng As Range, tmp
  With Target
    If .Column = 2 And .Row >= 2 Then
      tmp = Target.Offset(, -1).Value
      If .Value <> Empty Then
        Application.EnableEvents = False
        Set sRng = Sheet1.Range("A2", Sheet1.Range("A1000000").End(xlUp))
        Set Rng = sRng.Find(tmp, , xlFormulas, xlWhole)
        If Rng Is Nothing Then
          MsgBox "không có mã này"
          Target.Value = Empty
          Target.Select
        End If
        Application.EnableEvents = True
      End If
    End If
  End With
End Sub

 

[namdajka97x]

Phải bắt sự kiện cột "B"

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rng As Range, sRng As Range, tmp
  With Target
    If .Column = 2 And .Row >= 2 Then
      tmp = Target.Offset(, -1).Value
      If .Value <> Empty Then
        Application.EnableEvents = False
        Set sRng = Sheet1.Range("A2", Sheet1.Range("A1000000").End(xlUp))
        Set Rng = sRng.Find(tmp, , xlFormulas, xlWhole)
        If Rng Is Nothing Then
          MsgBox "không có mã này"
          Target.Value = Empty
          Target.Select
        End If
        Application.EnableEvents = True
      End If
    End If
  End With
End Sub

em cảm ơn bác nhiều ạ