Dò tìm tên bằng VBA thay cho công thức Vlookup (1 người xem)

[thuanntk]

Chào các bạn,
Nhờ các bạn dò tìm tên tài khoản ở sheet"TH_doiung" lấy từ sheet"MA" bằng VBA thay cho công thức dò tìm vlookup.Cảm ơn các bạn.

 

[thuanntk]

Tại sao phải thay vlookup bằng vba vậy bạn.
Trong code của bạn đoạn này, thêm vào dòng màu đỏ

If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            dArr(K, 1) = Tem
[COLOR=#ff0000][B]            dArr(K, 2) = Application.VLookup(Tem, Sheet2.[A4:B1000], 2, 0)[/B][/COLOR]
            If sArr(I, 10) Like DK Then dArr(K, 3) = sArr(I, 14)
            If sArr(I, 11) Like DK Then dArr(K, 4) = sArr(I, 14)
           
        Else

Cảm ơn bạn nhiều nghe, vì cồng thức khi chạy VBA sẽ bị xóa.

 

[thuanntk]

Tại sao phải thay vlookup bằng vba vậy bạn.
Trong code của bạn đoạn này, thêm vào dòng màu đỏ

If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            dArr(K, 1) = Tem
[COLOR=#ff0000][B]            dArr(K, 2) = Application.VLookup(Tem, Sheet2.[A4:B1000], 2, 0)[/B][/COLOR]
            If sArr(I, 10) Like DK Then dArr(K, 3) = sArr(I, 14)
            If sArr(I, 11) Like DK Then dArr(K, 4) = sArr(I, 14)
           
        Else

Nhờ bạn sửa VBA giúp mình để tên tài khoản đó nó định dạng canh bên trái được không bạn. làm phiền bạn quá

 

[thuanntk]

Cái chiện đó là do code tạo máy cái in chữ ký người ký này nọ của bạn phía sau mà ra. Cho nên theo tôi nghỉ là bạn code phải cố định cái vụ đó ở dòng khoản 5000. Cần thì hide dòng trống đi để in cho đep.

Code trên là do bạn tự viết ra hay là sao? nếu bạn tự viết ra thì bạn hiểu và tự chỉnh sửa được mà

ý là định dạng mỗi tên tài khoản mà có kết quả thôi, không định dạng phía dưới được không bạn, cái code này không phải mình viết bạn ơi, nên không rành lắm nhờ bạn giúp mình với

 

[comet_1701]

ý là định dạng mỗi tên tài khoản mà có kết quả thôi, không định dạng phía dưới được không bạn, cái code này không phải mình viết bạn ơi, nên không rành lắm nhờ bạn giúp mình với

.[C9:C18].HorizontalAlignment = xlLeft

Bạn thêm đoạn này vào sau If k then thôi, ngay từ đầu khi bạn hỏi vlo okup mình cũng đoán được chắc ai đó giúp bạn roài, hehe.

Sub Tim_Kiem()
    Dim Sarr, Darr, i&, Rng As Range, Rng1 As Range
    Set Rng = Sheets("TH_doiung").Range("B9:B18")
    With Sheets("MA")
        Sarr = .Range(.[A5], .[A65000].End(xlUp)).Resize(, 2)
    End With
    For i = 1 To UBound(Sarr)
        Set Rng1 = Rng.Find(Sarr(i, 1), , xlFormulas, xlWhole)
        If Not Rng1 Is Nothing Then
            Rng1.Offset(, 1).Value = Sarr(i, 2)
        End If
    Next i
    Set Rng = Nothing
    Set Rng1 = Nothing
End Sub

Bạn dùng như của hpkhuong là hợp lý, nếu muốn thêm code phụ lấy tên thì có thể xem tạm code trên.
chúc bạn thành công.

 

[thuanntk]

.[C9:C18].HorizontalAlignment = xlLeft

Bạn thêm đoạn này vào sau If k then thôi, ngay từ đầu khi bạn hỏi vlo okup mình cũng đoán được chắc ai đó giúp bạn roài, hehe.

Sub Tim_Kiem()
    Dim Sarr, Darr, i&, Rng As Range, Rng1 As Range
    Set Rng = Sheets("TH_doiung").Range("B9:B18")
    With Sheets("MA")
        Sarr = .Range(.[A5], .[A65000].End(xlUp)).Resize(, 2)
    End With
    For i = 1 To UBound(Sarr)
        Set Rng1 = Rng.Find(Sarr(i, 1), , xlFormulas, xlWhole)
        If Not Rng1 Is Nothing Then
            Rng1.Offset(, 1).Value = Sarr(i, 2)
        End If
    Next i
    Set Rng = Nothing
    Set Rng1 = Nothing
End Sub

Bạn dùng như của hpkhuong là hợp lý, nếu muốn thêm code phụ lấy tên thì có thể xem tạm code trên.
chúc bạn thành công.

Nếu kết quả có số dòng nhiều hơn C18 là không định dấngng trái được bạn ơi

 

[comet_1701]

Nếu kết quả có số dòng nhiều hơn C18 là không định dấngng trái được bạn ơi

ví dụ thôi mà bạn, resize(k,1) đó như của hpkhuong là ok roài. Bạn tập sửa cho quen, sau lên GPE mà chế dần