Xin code đếm ký tự theo điều kiện (1 người xem)

[Nguyễn Hồng Quang]

Dear all
Mình có 1 bảng dữ liệu (đã rút gọn) Hiện tại mình đang dùng công thức tại ô AC2=IF(B2=13;0;"kiem tra lai ma vat tu dang co "&LEN(B2)&" so")
Tuy nhiên vì số lượng dòng của mỗi bảng dữ liệu thường lớn và thay đổi, nên mình muốn xin mọi người giúp cho mình code trong vba để đếm số ký tự theo điều kiện. Nếu số ký tự = 13 thì blank , nếu số ký tự khác 13 thì trả kết quả là "Kiem tra lai ma vat tu dang co ...."
(chi tiết xem file gửi kèm)
Xin cảm ơn rất nhiều

 

[Ba Tê]

Dear all
Mình có 1 bảng dữ liệu (đã rút gọn) Hiện tại mình đang dùng công thức tại ô AC2=IF(B2=13;0;"kiem tra lai ma vat tu dang co "&LEN(B2)&" so")
Tuy nhiên vì số lượng dòng của mỗi bảng dữ liệu thường lớn và thay đổi, nên mình muốn xin mọi người giúp cho mình code trong vba để đếm số ký tự theo điều kiện. Nếu số ký tự = 13 thì blank , nếu số ký tự khác 13 thì trả kết quả là "Kiem tra lai ma vat tu dang co ...."
(chi tiết xem file gửi kèm)
Xin cảm ơn rất nhiều

- Không thể IF(B2=13;.... được. vì B2 là Text không phải Number. Nếu muốn thì phải IF(Len(B2)=13;....
- Kiểm tra xong thì bạn phải chỉnh lại từng dòng Mã cho đủ 13 ký tự? Trước đây có bài bạn hỏi về xóa khoảng trắng, sao không xóa xong thì chuyển thành 13 ký tự luôn?

 

[Nguyễn Hồng Quang]

- Không thể IF(B2=13;.... được. vì B2 là Text không phải Number. Nếu muốn thì phải IF(Len(B2)=13;....
- Kiểm tra xong thì bạn phải chỉnh lại từng dòng Mã cho đủ 13 ký tự? Trước đây có bài bạn hỏi về xóa khoảng trắng, sao không xóa xong thì chuyển thành 13 ký tự luôn?

Sorry bác Bate lúc nãy mình viết sót thiếu mất Len
Ý của mình ở đây chỉ là chỉ check lại mã vật tư xem đã đúng tiêu chuẩn 13 số thôi, nên muốn xin 1 code để có thể thông báo cho người nhập liệu biết
Vì Nếu sau khi đã xóa khoảng trắng mà có mã vật tư khác 13 số thì người nhập dữ liệu phải kiểm tra lại thông tin

Ghi chú: mình nói thêm chút về quy trình mình đang xây dựng cho nhân viên nhập liệu:
1- Copy paste từ nguồn dữ liệu về file excel
2- Xóa khoảng trắng ở Mã vật tư (thông báo kết quả xóa khoảng trắng nếu có)
3- Kiểm tra lại mã vật tư đã theo tiêu chuẩn 13 số chưa (thông báo kết quả kiểm tra)
4- Save
(Về các bước 1,2,4 thì mình đã ok, chỉ còn bước 3 là chưa có code)
Rất Mong bác giúp đỡ

 

[Ba Tê]

Sorry bác Bate lúc nãy mình viết sót thiếu mất Len
Ý của mình ở đây chỉ là chỉ check lại mã vật tư xem đã đúng tiêu chuẩn 13 số thôi, nên muốn xin 1 code để có thể thông báo cho người nhập liệu biết
Vì Nếu sau khi đã xóa khoảng trắng mà có mã vật tư khác 13 số thì người nhập dữ liệu phải kiểm tra lại thông tin

Ghi chú: mình nói thêm chút về quy trình mình đang xây dựng cho nhân viên nhập liệu:
1- Copy paste từ nguồn dữ liệu về file excel
2- Xóa khoảng trắng ở Mã vật tư (thông báo kết quả xóa khoảng trắng nếu có)
3- Kiểm tra lại mã vật tư đã theo tiêu chuẩn 13 số chưa (thông báo kết quả kiểm tra)
4- Save
(Về các bước 1,2,4 thì mình đã ok, chỉ còn bước 3 là chưa có code)
Rất Mong bác giúp đỡ

Vậy thì code bước 3 đây:

Public Sub KiemTra()
Dim sArr(), dArr(), I As Long, R As Long, N As Long
R = Range("B65536").End(xlUp).Row
If R > 1 Then
    sArr = Range("B1:B" & R).Value
    ReDim dArr(1 To R, 1 To 1)
    For I = 2 To R
        N = Len(sArr(I, 1))
        If N <> 13 Then
            dArr(I - 1, 1) = "Kiem tra lai! Ma vat tu dang co " & N & " ky tu."
        End If
    Next I
    Range("AC2").Resize(R - 1) = dArr
End If
End Sub

 

[Nguyễn Hồng Quang]

Trước tiên xin được chân thành Cảm ơn bác bate nhiều
Tiếp đó mình xin gửi ai đó đang có nhu cầu tương tự và đang tìm kiếm trên google
đoạn code (lắp ghép) này với 2 bước (xóa khoảng trắng, báo cáo kết quả xóa khoảng trằng+ kiểm tra số ký tự sau khi đã xóa khoảng trắng so với 13 ký tự , báo cáo kết quả kiểm tra):

Sub xoakhoangtrangkethopkiemtra13kytu()   
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveCell.SpecialCells(xlLastCell).Select
    Range("U1").Select
    ActiveSheet.Paste
    Range("T1").Value = "Ket qua xoa khoang trang"
    Range("U1").Value = "Ma ban dau"


     Dim Vung, Kq() As String, I
    Vung = Range([B1], [B50000].End(xlUp))
    ReDim Kq(1 To UBound(Vung), 1 To 1)
    Kq(1, 1) = Vung(1, 1)
        For I = 2 To UBound(Vung)
            Vung(I, 1) = CStr(Vung(I, 1))
            Kq(I, 1) = Replace(Vung(I, 1), " ", "")
        Next I
    [B1].Resize(UBound(Vung)) = Kq
    
    
Dim sArr1(), dArr1(), eArr1(), J1 As Long, R1 As Long, N1 As Long, T1 As Long
T1 = Range("U65536").End(xlUp).Row
R1 = Range("B65536").End(xlUp).Row
If R1 > 1 Then
    sArr1 = Range("B1:B" & R1).Value
    eArr1 = Range("U1:U" & T1).Value
      ReDim dArr1(1 To R1, 1 To 1)
    For J1 = 2 To R1
        N1 = Len(eArr1(J1, 1)) - Len(sArr1(J1, 1))
        If N1 = 0 Then
            dArr1(J1 - 1, 1) = "khong xuat hien khoang trang"
    Else: dArr1(J1 - 1, 1) = "da xoa " & N1 & " khoang trang"
        End If
    Next J1
    Range("T2").Resize(R1 - 1) = dArr1
End If




    
Dim sArr(), dArr(), J As Long, R As Long, N As Long
R = Range("B65536").End(xlUp).Row
If R > 1 Then
    sArr = Range("B1:B" & R).Value
    ReDim dArr(1 To R, 1 To 1)
    For J = 2 To R
        N = Len(sArr(J, 1))
        If N <> 13 Then
            dArr(J - 1, 1) = "Kiem tra lai! Ma vat tu dang co " & N & " so"
    Else: dArr(J - 1, 1) = "OK! Ma 13 so."
        End If
    Next J
    Range("V2").Resize(R - 1) = dArr
End If
End Sub

Vì mình ko biết nhiều về VBA (chủ yếu chỉ đọc trên diễn đàn và tự tư duy) nên code của mình đơn thuần chỉ như trò Lego (hề hề được cái mình chơi lego từ bé ), lắp ghép lại với nhau thành 1 nhóm thực thi câu lệnh
Rất mong nhận được các cải tiến từ mọi người
File test gửi kèm mọi người tham khảo