Lọc dữ liệu bị lỗi khi định dạng khác font và font size của chữ (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

khongnhienttt

Thành viên hoạt động
Tham gia
15/7/15
Bài viết
137
Được thích
33
- Tình hình là mình có 1 list danh sách các số BHXH của 1 người khác chuyển sang, và mình thì có data gốc, họ cần lấy các thông tin trong data gốc, vì thích phong cách của thầy NDU nên cũng viết 1 hàm tổng quát để sử dụng cho các trường hợp, hàm sẽ nhận vào :vùng cần lọc dữ liệu, vùng data gốc, các cột cần lấy
- Tuy nhiên vấn đề là khi duyệt mảng để bóc dữ liệu thì đối với các số BHXH khác font hoặc font size khác nhau ( đoán là vậy vì mình có thử thay đổi font nhưng vẫn không hiểu) thì nó báo khác nhau, do đó mình phải copy từng cái khác đưa vào filter rồi copy nguyên ô trong data gốc qua thì nó mới hiểu
- Trong bài do những dữ liệu đầu data gốc không có nên báo not found, các bạn xem các cái bên dưới nhé
https://www.dropbox.com/s/17hwt5vtrjr62en/BHTN.xlsm?dl=0

Mã:
Function LocDuLieu(Dsloc As Range, data As Range, CotLoc As String)
    Dim ArrDSloc(), ArrData(), ArrCotLoc() As String, kq(), iDsloc As Long, iData As Long, j As Long, _
        k As Long, l As Integer, StrCotloc As Variant
    ArrDSloc = Dsloc: ArrData = data: ArrCotLoc = Split(CotLoc, ",")
    iDsloc = UBound(ArrDSloc, 1): iData = UBound(ArrData, 1)
    
    ReDim kq(1 To iDsloc, 1 To UBound(ArrCotLoc) + 2)
    
    For j = 1 To iDsloc
        For k = 1 To iData
            If ArrDSloc(j, 1) = ArrData(k, 1) Then
                l = 1
                For Each StrCotloc In ArrCotLoc
                    kq(j, 1) = ArrDSloc(j, 1)
                    l = l + 1
                    kq(j, l) = ArrData(k, CInt(StrCotloc))
                Next
            End If
        Next k
        If Len(kq(j, 1)) < 1 Then
            kq(j, 1) = ArrDSloc(j, 1)
            kq(j, 2) = "not found"
        End If
    Next j
    LocDuLieu = kq
End Function

Mã:
Sub Loc()
    Sheets("data").Range("b5:f166").Value = LocDuLieu(Sheets("data").Range("b5:b166"), _
        Sheet2.Range("b5:n" & Sheet2.Range("b5").End(xlDown).Row), "4,11,12,13")
End Sub
 
Web KT

Bài viết mới nhất

Back
Top Bottom