Lỗi tách chuỗi trong VBA

[hong loi]

Chào các Thầy các anh !
Code chạy báo lỗi ở dòng tách chuỗi, em không tìm thấy chỗ sai em xin các thầy các anh sửa giúp nhé. Em xin cám ơn ạ.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
If Not Intersect(Target, [E1]) Is Nothing Then
    Dim TonTong As Range, sRng As Range, Cls As Range, TenMatHang As String
        Set TonTong = Sheet7.Range(Sheet7.Range("L4"), Sheet7.Range("L1000").End(xlUp))
        For Each Cls In Sheet2.Range(Sheet2.Range("A4"), Sheet2.Range("A4").End(xlDown))
[COLOR=#0000ff]            Set TenMatHang = Application.WorksheetFunction.Left(Cls, Len(Cls) - 11)[/COLOR]
            Set sRng = TonTong.Find(TenMatHang, , xlFormulas, xlWhole)
            If sRng Is Nothing Then
                Cls.Offset(, 14) = sRng.Offset(, 1).Value
            Else
                Cls.Offset(, 14) = 0
            End If
        Next Cls
    Cancel = True
 End If
End Sub

Hình lỗi

 

[doveandrose]

bỏ chữ set trong Set TenMatHang đi là được .

 

[hong loi]

bỏ chữ set trong Set TenMatHang đi là được .

Vẫn còn lỗi chị doveandrose ơi, bỏ Set xong code báo lỗi khác , chị xem giúp nhé.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Not Intersect(Target, [E1]) Is Nothing Then
    Dim TonTong As Range, sRng As Range, Cls As Range, TenMatHang As String
        Set TonTong = Sheet7.Range(Sheet7.Range("L4"), Sheet7.Range("L1000").End(xlUp))
        For Each Cls In Sheet2.Range(Sheet2.Range("A4"), Sheet2.Range("A4").End(xlDown))
[COLOR=#ff0000]            TenMatHang = Application.WorksheetFunction.Left(Cls, Len(Cls) - 11)[/COLOR]
            Set sRng = TonTong.Find(TenMatHang, , xlFormulas, xlWhole)
            If sRng Is Nothing Then
                Cls.Offset(, 14) = sRng.Offset(, 1).Value
            Else
                Cls.Offset(, 14) = 0
            End If
        Next Cls
    Cancel = True
 End If
End Sub

 

[bebo021999]

Thử bỏ WorksheetFunction đi xem sao

 

[hong loi]

Thử bỏ WorksheetFunction đi xem sao

Vẫn chưa được anh bebo021999 ạ, code báo lỗi khác vẫn ở dòng đó

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Not Intersect(Target, [E1]) Is Nothing Then
    Dim TonTong As Range, sRng As Range, Cls As Range, TenMatHang As String
        Set TonTong = Sheet7.Range(Sheet7.Range("L4"), Sheet7.Range("L1000").End(xlUp))
        For Each Cls In Sheet2.Range(Sheet2.Range("A4"), Sheet2.Range("A4").End(xlDown))
[COLOR=#ff0000]            TenMatHang = Application.Left(Cls, Len(Cls) - 11)[/COLOR]
            Set sRng = TonTong.Find(TenMatHang, , xlFormulas, xlWhole)
            If sRng Is Nothing Then
                Cls.Offset(, 14) = sRng.Offset(, 1).Value
            Else
                Cls.Offset(, 14) = 0
            End If
        Next Cls
    Cancel = True
 End If
End Sub

 

[ndu96081631]

Vẫn chưa được anh bebo021999 ạ, code báo lỗi khác vẫn ở dòng đó

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Not Intersect(Target, [E1]) Is Nothing Then
    Dim TonTong As Range, sRng As Range, Cls As Range, TenMatHang As String
        Set TonTong = Sheet7.Range(Sheet7.Range("L4"), Sheet7.Range("L1000").End(xlUp))
        For Each Cls In Sheet2.Range(Sheet2.Range("A4"), Sheet2.Range("A4").End(xlDown))
[COLOR=#ff0000]            TenMatHang = Application.Left(Cls, Len(Cls) - 11)[/COLOR]
            Set sRng = TonTong.Find(TenMatHang, , xlFormulas, xlWhole)
            If sRng Is Nothing Then
                Cls.Offset(, 14) = sRng.Offset(, 1).Value
            Else
                Cls.Offset(, 14) = 0
            End If
        Next Cls
    Cancel = True
 End If
End Sub

View attachment 164104

Hổng phải vậy!
Bỏ tất tần tật, bỏ cả Application luôn, chỉ chừa lại TenMatHang = Left(Cls, Len(Cls) - 11) thôi

 

[hong loi]

Hổng phải vậy!
Bỏ tất tần tật, bỏ cả Application luôn, chỉ chừa lại TenMatHang = Left(Cls, Len(Cls) - 11) thôi

Dạ đúng rồi Thầy ơi, em cám ơn Thầy nhiều. Bây giờ lại báo lỗi ở dòng khác

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Not Intersect(Target, [E1]) Is Nothing Then
    Dim TonTong As Range, sRng As Range, Cls As Range, TenMatHang As String
        Set TonTong = Sheet7.Range(Sheet7.Range("L4"), Sheet7.Range("L1000").End(xlUp))
        For Each Cls In Sheet2.Range(Sheet2.Range("A4"), Sheet2.Range("A4").End(xlDown))
            TenMatHang = Left(Cls, Len(Cls) - 11)
            Set sRng = TonTong.Find(TenMatHang, , xlFormulas, xlWhole)
            If sRng Is Nothing Then
[COLOR=#ff0000]                Cls.Offset(, 14) = sRng.Offset(, 1).Value[/COLOR]
            Else
                Cls.Offset(, 14) = 0
            End If
        Next Cls
    Cancel = True
 End If
End Sub

Hình Lỗi

Code này làm nhiệm vụ như sau:
Ví dụ tại ô A11 (ở sheet có sheetname là sheet2) có value là Khau trang tim G3-07/1900
Dòng code TenMatHang = Left(Cls, Len(Cls) - 11) tách Khau trang tim G3-07/1900 còn lại Khau trang tim,
rồi lấy tên Khau trang tim dò tìm trong vùng dữ liệu ở cột L ( của sheet có sheetname là sheet7 )

Nếu tìm thấy thì lấy số lượng ở cột kế bên là cột M( của sheet có sheetname là sheet7 ) gán vào ô P11 (ở sheet có sheetname là sheet2) tương đương dòng code Cls.Offset(, 14) = sRng.Offset(, 1).Value

Nếu không tìm thấy thì gán số 0 vào ô P11 tương đương dòng Cls.Offset(, 14) = 0

Em không biết sai chỗ nào nhờ Thầy cùng các anh xem sửa giúp code luôn nhé, em rất cám ơn ạ.

 

[doveandrose]

bạn nhét lộn chuồng rồi dòng

[COLOR=#000000]If sRng Is Nothing Then[/COLOR]

vậy sRng đang Nothing mà sao sRng.Offset(, 1).Value được ...

 

[HieuCD]

hình như là
If not sRng Is Nothing Then

 

[hong loi]

hình như là
If not sRng Is Nothing Then

Cám ơn anh HieuCD nhé, đúng như anh góp ý If not sRng Is Nothing Then.

Cám ơn chị doveandrose. Nếu dùng sRng Is Nothing thì phải sửa thành vầy

      If sRng Is Nothing Then
                Cls.Offset(, 14) = 0
            Else
                Cls.Offset(, 14) = sRng.Offset(, 1).Value
            End If