Xin mã VBA như hàm Vloopkup nhưng lấy được cả formats , comments của ô được tìm kiếm

Liên hệ QC

kienphamiuh

Thành viên chính thức
Tham gia
8/12/18
Bài viết
66
Được thích
11
-em có 1 vấn đề nhờ các anh chị trong group giúp ạ
-em có 1 File excel ( sheep 1 là "thông tin", sheep 2 là "file tổng")
+ em sử dụng làm Vlookup để lấy thông tin từ "file tổng" chuyển qua file " thông tin" dựa vào Mã HV
+ Vấn đề em gặp là Vlookup chỉ lấy được giá trị mà không lấy đc: màu sắc của ô ( ô được tô màu vàng ), comment, màu sắc của chữ ( chữ màu đỏ ).
- em mong anh chị giúp tạo 1 hàm Xlookup có chức năng như Vlookup nhưng lấy được giá trị và cả (màu sắc của ô,comment, màu sắc của chữ ) , còn nếu không thể làm 1 hàm như Xlookup anh chị giúp em viết code lấy giá trị và màu sắc của ô,comment, màu sắc của chữ dựa vào mã HV trong file " thông tin" ạ
vd: =Xlookup ( X, Y ,Z ,0 or 1)
X là Giá trị dùng để dò tìm
Y là Bảng giá trị dò
Z là Thứ tự của cột cần lấy dữ liệu trên bảng giá trị dò
0 là giá trị tuyệt đối
X Y Z là các giá trị mình nhập ( linh động như ham vlookup ), mong các anh chị giúp, em cảm ơn nhiều " trong code có giải thích code thì càng tốt ạ "

em có viết 1 đoan VBA như sau :
Function Xlookup(cn As String)
Xlookup = Sheet2.Range("a:a").Find(cn).Offset(, 1).Value
End Function
nhưng nhựơc điểm là không linh động cột cần lấy, mỗi lần lấy phải vào code sửa offset và không lấy được màu sắc của ô,comment, màu sắc của chữ ( còn thua xài vlookup nữa anh chị ạ :(( )
 

File đính kèm

  • file.xlsx
    12.5 KB · Đọc: 18
Cho hỏi nếu tôi có các sheet giống nhau cấu trúc nhưng cột Điểm TL ở các sheet khác nhau. Tôi muốn gộp lại vào sheet tổng hợp thì làm sao?
 

File đính kèm

  • gop cac sheet.xlsx
    136 KB · Đọc: 9
Upvote 0
Cho hỏi nếu tôi có các sheet giống nhau cấu trúc nhưng cột Điểm TL ở các sheet khác nhau. Tôi muốn gộp lại vào sheet tổng hợp thì làm sao?
- Bạn coi file này ổn không, bạn vào sheet4 bấm vào nút tổng hợp file , thì sẽ có file tổng hợp 3 sheet của bạn, nhưng mỗi lần bạn tổng hợp file thì phải xoá sheet tên "Tong Hop" đi vì nếu để sheet này sẽ bị trùng tên với sheet tổng hợp tiếp theo code sẽ ko chạy.
- Các anh chị coi code này có cần thêm bớt gì không ạ
Mã:
Sub tong_hop_du_lieu()
    Dim shAll As Worksheet
    Dim sh As Worksheet
    Dim count As Integer
    Dim lastrow As Long
    
    Set shAll = Worksheets.Add
    shAll.Name = "Tong Hop"
    
    For Each sh In Worksheets
        If sh.Name <> shAll.Name Then
            count = count + 1
            If count = 1 Then
                sh.Range("A1:N" & sh.Range("A" & Rows.count).End(xlUp).Row).Copy _
                shAll.Range("A1")
            Else
                sh.Range("A2:N" & sh.Range("A" & Rows.count).End(xlUp).Row).Copy _
                shAll.Range("A" & lastrow + 1)
            End If
            lastrow = shAll.Range("A" & Rows.count).End(xlUp).Row
        End If
    Next sh
End Sub
 

File đính kèm

  • gop cac sheet.xlsm
    145.5 KB · Đọc: 13
Upvote 0
- Bạn coi file này ổn không, bạn vào sheet4 bấm vào nút tổng hợp file , thì sẽ có file tổng hợp 3 sheet của bạn, nhưng mỗi lần bạn tổng hợp file thì phải xoá sheet tên "Tong Hop" đi vì nếu để sheet này sẽ bị trùng tên với sheet tổng hợp tiếp theo code sẽ ko chạy.
- Các anh chị coi code này có cần thêm bớt gì không ạ
Mã:
Sub tong_hop_du_lieu()
    Dim shAll As Worksheet
    Dim sh As Worksheet
    Dim count As Integer
    Dim lastrow As Long
  
    Set shAll = Worksheets.Add
    shAll.Name = "Tong Hop"
  
    For Each sh In Worksheets
        If sh.Name <> shAll.Name Then
            count = count + 1
            If count = 1 Then
                sh.Range("A1:N" & sh.Range("A" & Rows.count).End(xlUp).Row).Copy _
                shAll.Range("A1")
            Else
                sh.Range("A2:N" & sh.Range("A" & Rows.count).End(xlUp).Row).Copy _
                shAll.Range("A" & lastrow + 1)
            End If
            lastrow = shAll.Range("A" & Rows.count).End(xlUp).Row
        End If
    Next sh
End Sub
Bài đã được tự động gộp:

Không được rồi!
Vì cột L có dữ liệu của 3 sheet phải được gộp lại mới đúng
 
Upvote 0
Bài đã được tự động gộp:

Không được rồi!
Vì cột L có dữ liệu của 3 sheet phải được gộp lại mới đúng
phải được gộp lại là sao anh, chưa hiểu lắm ?
Bài đã được tự động gộp:

Bài đã được tự động gộp:

Không được rồi!
Vì cột L có dữ liệu của 3 sheet phải được gộp lại mới đúng
ý anh là các dòng có dữ liệu ở cột L sẽ được gộp lại thành 1 sheet khác đúng không ?
 
Upvote 0
Cho hỏi nếu tôi có các sheet giống nhau cấu trúc nhưng cột Điểm TL ở các sheet khác nhau. Tôi muốn gộp lại vào sheet tổng hợp thì làm sao?
tất cả các sheet đều giống nhau nên sheet TongHop là có sẵn, Code chỉ lấy dữ liệu cột L của các sheet về TongHop.
 

File đính kèm

  • gop cac sheet.rar
    193.5 KB · Đọc: 18
Upvote 0
Cảm ơn nhiều nhé
 
Upvote 0
Xin chào thầy ạ :D
Bài đã được tự động gộp:



Oanh Thơ mới học code nên giải thích có thể bạn và những người khác chưa hiểu code này sẽ không hiểu. híc:
Mã:
With shtData 'là "Sheet2"
For i = LBound(varKey) To UBound(varKey) ' bắt đầu từ dòng 2 đến dòng cuối trong cột A

Set c = .Columns("A").Find(What:=varKey(i, 1), _
After:=.Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlNext) ' gán cho biến c một ô tìm kiếm được trong cột A của sheet2
If c Is Nothing Then ' nếu không tìm thấy C
shtKQ.Cells(i + 1, 2).Value = "#N/A" ' trả về "#N/A" giống như vlookup không tìm thấy từ khóa trong bảng tìm kiếm
Else ' nếu tìm thấy
c.Resize(1, 2).Offset(0, 1).Copy Destination:=shtKQ.Cells(i + 1, 2)  ' từ ô tìm kiếm được quét sang phải 1 cột,và nhảy thêm 1 cột nữa rồi copy vùng này sau đó đặt con trỏ tại dòng i cột 2 rồi pase.
End If
Next i
End With
End Sub
Xin chào Ms. Oanh Thơ

Bạn có thể cho mình hỏi với đoạn Code trên thì làm sao để copy giá trị thôi không copy format và công thức
 
Upvote 0
Xin chào Ms. Oanh Thơ

Bạn có thể cho mình hỏi với đoạn Code trên thì làm sao để copy giá trị thôi không copy format và công thức

Xin chào Nguyentu95, bạn lấy code và file ở bài này của thầy Ba Tê nhé:

https://www.giaiphapexcel.com/diendan/threads/xin-mã-vba-như-hàm-vloopkup-nhưng-lấy-được-cả-formats-comments-của-ô-được-tìm-kiếm.139556/#post-895976


bỏ dòng:
Cll.Offset(, 7).Resize(, 2).Copy Rng.Offset(, 8) ' Lay ca format + value
thay thành:
Cll.Offset(, 7).Resize(, 2).Copy
Rng.Offset(, 8).PasteSpecial xlPasteValues

Mã:
Option Explicit

Public Sub sGPE()
Dim sRng As Range, dRng As Range, Cll As Range, Rng As Range, Txt As String
Set sRng = Sheets("DANH SACH TONG").Range("B4", Sheets("DANH SACH TONG").Range("B4").End(xlDown))
Set dRng = Sheets("FILE GUI").Range("B12", Sheets("FILE GUI").Range("B12").End(xlDown))
For Each Rng In dRng
    Txt = Rng.Value
    For Each Cll In sRng
        If Cll.Value = Txt Then
             Rem Cll.Offset(, 7).Resize(, 2).Copy Rng.Offset(, 8) ' Lay ca format + value
             Cll.Offset(, 7).Resize(, 2).Copy
             Rng.Offset(, 8).PasteSpecial xlPasteValues
            Exit For
        End If
    Next Cll
Next Rng
End Sub

Nếu bạn muốn lấy value không thì dùng mảng thì tốc độ nhanh hơn code nhiều. Về mảng OT đang tìm hiểu bạn có thể gửi file kèm và nêu mong muốn nên đây để mọi người xem và giúp cho bạn.
 
Upvote 0
Nếu bạn đang học viết code thì:
- Luôn phải xóa kết quả cũ. Trong bài mà bạn cho link bạn thử như sau: nhấn GPE -> bạn có kết quả trong J12:K29 -> sau một thời gian xóa đi, nhập lại, sửa thì cột B trong sheet FILE GUI chỉ có 3 dòng dữ liệu B12:B14 -> nhấn GPE -> bạn vẫn có 18 kết quả trong J12:K29
Bạn không biết đâu là kết quả mới, đâu là kết quả cũ.
Tất nhiên người nhập liệu khi xóa chì còn 3 dòng dữ liệu B12:B14 thì anh ta nên tự xóa cả các kết quả trong J:K. Nhưng đấy là việc của anh ta. Anh ta có thể làm mà cũng có thể không. Người viết code hãy làm nhiệm vụ của bản thân mình và đừng bao giờ giả thiết là anh nhập liệu luôn ý thức được trách nhiệm của mình, luôn tỉnh táo, luôn không nhầm lẫn. Việc của người ta thì để người ta làm, việc của mình thì mình làm, đừng giả thiết là người khác sẽ chuẩn, sẽ có trách nhiệm.

- Người viết code không được phép giả thiết là dữ liệu luôn liên tục, không có dòng trống. Dùng xlDown? Nếu 'DANH SACH TONG'!B7 = rỗng thì sau khi chạy GPE sẽ thiếu kết quả. Tương tự khi vd. 'FILE GUI'!B15 = rỗng.
Dữ liệu liên tục thì tốt nhưng là người viết code thì không được phép mặc định như thế.

- Người viết code không được phép giả thiết là luôn có dữ liệu. Nếu cột B trong 'FILE GUI' hoặc/và 'DANH SACH TONG' không có dữ liệu thì dRng hoặc/và sRng sẽ có hàng triệu dòng. Lúc đó thì nhấn GPE rồi đi nhậu.

Tóm lại người viết code nên lường được những trường hợp dữ liệu, những sự cố có thể có và xử lý chúng. Càng lường được nhiều tình huống càng tốt. Trên đây tôi chỉ liệt kê ra 3 vấn đề mà người viết code bắt buộc phải xử lý.

Bạn tham khảo code ở dưới. Code dài hơn code ở link vì:
- gộp 2 trường hợp: chỉ lấy giá trị, và lấy giá trị và format.
- xóa kết quả cũ, xử lý trường hợp không có dữ liệu, và khi dữ liệu không liên tục.

Gán cho nút GPE macro test
Mã:
Private Sub sGPE(Optional ByVal format As Boolean = False)
Dim lastRow As Long, r1 As Long, r2 As Long, shSrc As Worksheet, shDest As Worksheet, csdl(), data(), result(), text As String
    Set shDest = Worksheets("FILE GUI")
    With shDest
'        xoa ket qua cu
        lastRow = .Cells(Rows.Count, "J").End(xlUp).Row
        If lastRow >= 12 Then
            With .Range("J12:K" & lastRow)
                .Clear
                .Borders.LineStyle = xlContinuous
            End With
        End If
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
'        neu khong co du lieu thi ket thuc cuoc choi, nguoc lai lay vao mang data
        If lastRow < 12 Then Exit Sub
        data = .Range("B12:B" & lastRow + 1).Value
'        mang ket qua
        If Not format Then ReDim result(1 To UBound(data) - 1, 1 To 2)
    End With
    Set shSrc = Worksheets("DANH SACH TONG")
    With shSrc
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
'        neu khong co du lieu thi ket thuc cuoc choi, nguoc lai lay vao mang csdl
        If lastRow < 4 Then Exit Sub
        csdl = .Range("B4:J" & lastRow).Value
    End With
    For r1 = 1 To UBound(data) - 1
        text = data(r1, 1)
        For r2 = 1 To UBound(csdl)
            If csdl(r2, 1) = text Then
                If format Then
                    shSrc.Cells(3 + r2, "I").Resize(, 2).Copy shDest.Cells(11 + r1, "J")
                Else
                    result(r1, 1) = csdl(r2, 8)
                    result(r1, 2) = csdl(r2, 9)
                End If
                Exit For
            End If
        Next r2
    Next r1
    If Not format Then shDest.Range("J12").Resize(UBound(result), 2).Value = result
End Sub

Sub test()
'    chi lay gia tri
    sGPE
'    lay gia tri va format
'    sGPE True
End Sub
 
Upvote 0
Nếu bạn đang học viết code thì:
- Luôn phải xóa kết quả cũ. Trong bài mà bạn cho link bạn thử như sau: nhấn GPE -> bạn có kết quả trong J12:K29 -> sau một thời gian xóa đi, nhập lại, sửa thì cột B trong sheet FILE GUI chỉ có 3 dòng dữ liệu B12:B14 -> nhấn GPE -> bạn vẫn có 18 kết quả trong J12:K29
Bạn không biết đâu là kết quả mới, đâu là kết quả cũ.
Tất nhiên người nhập liệu khi xóa chì còn 3 dòng dữ liệu B12:B14 thì anh ta nên tự xóa cả các kết quả trong J:K. Nhưng đấy là việc của anh ta. Anh ta có thể làm mà cũng có thể không. Người viết code hãy làm nhiệm vụ của bản thân mình và đừng bao giờ giả thiết là anh nhập liệu luôn ý thức được trách nhiệm của mình, luôn tỉnh táo, luôn không nhầm lẫn. Việc của người ta thì để người ta làm, việc của mình thì mình làm, đừng giả thiết là người khác sẽ chuẩn, sẽ có trách nhiệm.

- Người viết code không được phép giả thiết là dữ liệu luôn liên tục, không có dòng trống. Dùng xlDown? Nếu 'DANH SACH TONG'!B7 = rỗng thì sau khi chạy GPE sẽ thiếu kết quả. Tương tự khi vd. 'FILE GUI'!B15 = rỗng.
Dữ liệu liên tục thì tốt nhưng là người viết code thì không được phép mặc định như thế.

- Người viết code không được phép giả thiết là luôn có dữ liệu. Nếu cột B trong 'FILE GUI' hoặc/và 'DANH SACH TONG' không có dữ liệu thì dRng hoặc/và sRng sẽ có hàng triệu dòng. Lúc đó thì nhấn GPE rồi đi nhậu.

Tóm lại người viết code nên lường được những trường hợp dữ liệu, những sự cố có thể có và xử lý chúng. Càng lường được nhiều tình huống càng tốt. Trên đây tôi chỉ liệt kê ra 3 vấn đề mà người viết code bắt buộc phải xử lý.

Bạn tham khảo code ở dưới. Code dài hơn code ở link vì:
- gộp 2 trường hợp: chỉ lấy giá trị, và lấy giá trị và format.
- xóa kết quả cũ, xử lý trường hợp không có dữ liệu, và khi dữ liệu không liên tục.

Gán cho nút GPE macro test
Mã:
Private Sub sGPE(Optional ByVal format As Boolean = False)
Dim lastRow As Long, r1 As Long, r2 As Long, shSrc As Worksheet, shDest As Worksheet, csdl(), data(), result(), text As String
    Set shDest = Worksheets("FILE GUI")
    With shDest
'        xoa ket qua cu
        lastRow = .Cells(Rows.Count, "J").End(xlUp).Row
        If lastRow >= 12 Then
            With .Range("J12:K" & lastRow)
                .Clear
                .Borders.LineStyle = xlContinuous
            End With
        End If
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
'        neu khong co du lieu thi ket thuc cuoc choi, nguoc lai lay vao mang data
        If lastRow < 12 Then Exit Sub
        data = .Range("B12:B" & lastRow + 1).Value
'        mang ket qua
        If Not format Then ReDim result(1 To UBound(data) - 1, 1 To 2)
    End With
    Set shSrc = Worksheets("DANH SACH TONG")
    With shSrc
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
'        neu khong co du lieu thi ket thuc cuoc choi, nguoc lai lay vao mang csdl
        If lastRow < 4 Then Exit Sub
        csdl = .Range("B4:J" & lastRow).Value
    End With
    For r1 = 1 To UBound(data) - 1
        text = data(r1, 1)
        For r2 = 1 To UBound(csdl)
            If csdl(r2, 1) = text Then
                If format Then
                    shSrc.Cells(3 + r2, "I").Resize(, 2).Copy shDest.Cells(11 + r1, "J")
                Else
                    result(r1, 1) = csdl(r2, 8)
                    result(r1, 2) = csdl(r2, 9)
                End If
                Exit For
            End If
        Next r2
    Next r1
    If Not format Then shDest.Range("J12").Resize(UBound(result), 2).Value = result
End Sub

Sub test()
'    chi lay gia tri
    sGPE
'    lay gia tri va format
'    sGPE True
End Sub

Con chào bác Siwtom,
Cảm ơn bác nhiều vì đã chia sẻ kinh nghiệm và chỉ dẫn cho con biết thêm cách kết hợp sử dụng mảng ạ.
Kính chúc bác ngày mới vui khỏe.
 
Upvote 0
Upvote 0
Xin chào Nguyentu95, bạn lấy code và file ở bài này của thầy Ba Tê nhé:

https://www.giaiphapexcel.com/diendan/threads/xin-mã-vba-như-hàm-vloopkup-nhưng-lấy-được-cả-formats-comments-của-ô-được-tìm-kiếm.139556/#post-895976


bỏ dòng:

thay thành:


Mã:
Option Explicit

Public Sub sGPE()
Dim sRng As Range, dRng As Range, Cll As Range, Rng As Range, Txt As String
Set sRng = Sheets("DANH SACH TONG").Range("B4", Sheets("DANH SACH TONG").Range("B4").End(xlDown))
Set dRng = Sheets("FILE GUI").Range("B12", Sheets("FILE GUI").Range("B12").End(xlDown))
For Each Rng In dRng
    Txt = Rng.Value
    For Each Cll In sRng
        If Cll.Value = Txt Then
             Rem Cll.Offset(, 7).Resize(, 2).Copy Rng.Offset(, 8) ' Lay ca format + value
             Cll.Offset(, 7).Resize(, 2).Copy
             Rng.Offset(, 8).PasteSpecial xlPasteValues
            Exit For
        End If
    Next Cll
Next Rng
End Sub

Nếu bạn muốn lấy value không thì dùng mảng thì tốc độ nhanh hơn code nhiều. Về mảng OT đang tìm hiểu bạn có thể gửi file kèm và nêu mong muốn nên đây để mọi người xem và giúp cho bạn.
Rất vui khi được ban giúp đỡ,
Cảm ơn Ms. Oanh Thơ nhiều!

Công việc của mình liên quan đến Vlookup khá nhiều và phải copy-paste dữ liệu từ sheet A qua Sheet B để làm báo cáo so sánh, mình có học qua 1 khóa VBA cơ bản nên cũng chưa có nắm được mong học tập được từ bạn nhiều!
Mình gửi kèm file liên quan đến công việc hàng ngày của mình và trình bày để mong nhận được sự giúp đỡ như sau:

- I: Lấy dữ liệu từ dạng Value từ sheet 1 qua sheet 2 và sheet 3 với điều kiện dò tìm theo tên đầu mục nằm trong 1 cột được lựa chọn từ Box hiện lên mỗi khi chạy code. ( Với file mình gửi thì cột dò tìm ở sheet 1 là "B", dò tìm với cột "C" ở sheet 2, sheet 3, nếu trùng thì lấy dữ liệu Value từ cột C=>H của sheet 1 điền vô dòng tương ứng ở Sheet 2, 3 ). Vấn đề nữa là Sheet 1 của mình có dữ liệu về số thay đổi trong cột D => H thì làm sao để Sheet 2,3 tự cập nhật được điều này mà không cần chạy lại Code VBA?

- II: Trong trường hợp mình có 1 file như file kết quả sau khi chạy Code VBA ở yêu cầu I làm thế nào để lấy dữ liệu ở cả 2 sheet 2 và 3 ở cột "D" để điền vô cột "I" của sheet 1 vẫn với điều kiện dò tìm là tên đầu mục ở cột C sheet 2,3 trùng với tên đầu mục ở cột B sheet 1 thì lấy Value để thực hiện công tác so sánh?
 

File đính kèm

  • File yeu cau I.xlsm
    30.1 KB · Đọc: 3
  • File yeu cau II.xlsm
    27 KB · Đọc: 3
Upvote 0
Nếu bạn đang học viết code thì:
- Luôn phải xóa kết quả cũ. Trong bài mà bạn cho link bạn thử như sau: nhấn GPE -> bạn có kết quả trong J12:K29 -> sau một thời gian xóa đi, nhập lại, sửa thì cột B trong sheet FILE GUI chỉ có 3 dòng dữ liệu B12:B14 -> nhấn GPE -> bạn vẫn có 18 kết quả trong J12:K29
Bạn không biết đâu là kết quả mới, đâu là kết quả cũ.
Tất nhiên người nhập liệu khi xóa chì còn 3 dòng dữ liệu B12:B14 thì anh ta nên tự xóa cả các kết quả trong J:K. Nhưng đấy là việc của anh ta. Anh ta có thể làm mà cũng có thể không. Người viết code hãy làm nhiệm vụ của bản thân mình và đừng bao giờ giả thiết là anh nhập liệu luôn ý thức được trách nhiệm của mình, luôn tỉnh táo, luôn không nhầm lẫn. Việc của người ta thì để người ta làm, việc của mình thì mình làm, đừng giả thiết là người khác sẽ chuẩn, sẽ có trách nhiệm.

- Người viết code không được phép giả thiết là dữ liệu luôn liên tục, không có dòng trống. Dùng xlDown? Nếu 'DANH SACH TONG'!B7 = rỗng thì sau khi chạy GPE sẽ thiếu kết quả. Tương tự khi vd. 'FILE GUI'!B15 = rỗng.
Dữ liệu liên tục thì tốt nhưng là người viết code thì không được phép mặc định như thế.

- Người viết code không được phép giả thiết là luôn có dữ liệu. Nếu cột B trong 'FILE GUI' hoặc/và 'DANH SACH TONG' không có dữ liệu thì dRng hoặc/và sRng sẽ có hàng triệu dòng. Lúc đó thì nhấn GPE rồi đi nhậu.

Tóm lại người viết code nên lường được những trường hợp dữ liệu, những sự cố có thể có và xử lý chúng. Càng lường được nhiều tình huống càng tốt. Trên đây tôi chỉ liệt kê ra 3 vấn đề mà người viết code bắt buộc phải xử lý.

Bạn tham khảo code ở dưới. Code dài hơn code ở link vì:
- gộp 2 trường hợp: chỉ lấy giá trị, và lấy giá trị và format.
- xóa kết quả cũ, xử lý trường hợp không có dữ liệu, và khi dữ liệu không liên tục.

Gán cho nút GPE macro test
Mã:
Private Sub sGPE(Optional ByVal format As Boolean = False)
Dim lastRow As Long, r1 As Long, r2 As Long, shSrc As Worksheet, shDest As Worksheet, csdl(), data(), result(), text As String
    Set shDest = Worksheets("FILE GUI")
    With shDest
'        xoa ket qua cu
        lastRow = .Cells(Rows.Count, "J").End(xlUp).Row
        If lastRow >= 12 Then
            With .Range("J12:K" & lastRow)
                .Clear
                .Borders.LineStyle = xlContinuous
            End With
        End If
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
'        neu khong co du lieu thi ket thuc cuoc choi, nguoc lai lay vao mang data
        If lastRow < 12 Then Exit Sub
        data = .Range("B12:B" & lastRow + 1).Value
'        mang ket qua
        If Not format Then ReDim result(1 To UBound(data) - 1, 1 To 2)
    End With
    Set shSrc = Worksheets("DANH SACH TONG")
    With shSrc
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
'        neu khong co du lieu thi ket thuc cuoc choi, nguoc lai lay vao mang csdl
        If lastRow < 4 Then Exit Sub
        csdl = .Range("B4:J" & lastRow).Value
    End With
    For r1 = 1 To UBound(data) - 1
        text = data(r1, 1)
        For r2 = 1 To UBound(csdl)
            If csdl(r2, 1) = text Then
                If format Then
                    shSrc.Cells(3 + r2, "I").Resize(, 2).Copy shDest.Cells(11 + r1, "J")
                Else
                    result(r1, 1) = csdl(r2, 8)
                    result(r1, 2) = csdl(r2, 9)
                End If
                Exit For
            End If
        Next r2
    Next r1
    If Not format Then shDest.Range("J12").Resize(UBound(result), 2).Value = result
End Sub

Sub test()
'    chi lay gia tri
    sGPE
'    lay gia tri va format
'    sGPE True
End Sub
Dạ, Hay quá
Cảm ơn Thầy nhiều, kính chúc thầy nhiều sức khỏe!
 
Upvote 0
Xin chào Nguyentu95, bạn lấy code và file ở bài này của thầy Ba Tê nhé:

https://www.giaiphapexcel.com/diendan/threads/xin-mã-vba-như-hàm-vloopkup-nhưng-lấy-được-cả-formats-comments-của-ô-được-tìm-kiếm.139556/#post-895976


bỏ dòng:

thay thành:


Mã:
Option Explicit

Public Sub sGPE()
Dim sRng As Range, dRng As Range, Cll As Range, Rng As Range, Txt As String
Set sRng = Sheets("DANH SACH TONG").Range("B4", Sheets("DANH SACH TONG").Range("B4").End(xlDown))
Set dRng = Sheets("FILE GUI").Range("B12", Sheets("FILE GUI").Range("B12").End(xlDown))
For Each Rng In dRng
    Txt = Rng.Value
    For Each Cll In sRng
        If Cll.Value = Txt Then
             Rem Cll.Offset(, 7).Resize(, 2).Copy Rng.Offset(, 8) ' Lay ca format + value
             Cll.Offset(, 7).Resize(, 2).Copy
             Rng.Offset(, 8).PasteSpecial xlPasteValues
            Exit For
        End If
    Next Cll
Next Rng
End Sub

Nếu bạn muốn lấy value không thì dùng mảng thì tốc độ nhanh hơn code nhiều. Về mảng OT đang tìm hiểu bạn có thể gửi file kèm và nêu mong muốn nên đây để mọi người xem và giúp cho bạn.
Hi Ms. Oanh Thơ

Với Code này khi 1 trong 2 sheet có 1 dòng trống ở giữa thì file chỉ cho ra kết quả tới dòng trước dòng trống và dừng Code. Bạn có thể sửa cho Code chạy hết khi có dòng chống.
 

File đính kèm

  • Khi co dong trong thi bi loi.xlsm
    51.6 KB · Đọc: 8
Upvote 0
Hi Ms. Oanh Thơ

Với Code này khi 1 trong 2 sheet có 1 dòng trống ở giữa thì file chỉ cho ra kết quả tới dòng trước dòng trống và dừng Code. Bạn có thể sửa cho Code chạy hết khi có dòng chống.
Bạn thử thay lại như thế này xem sao
Mã:
Set sRng = Sheets("DANH SACH TONG").Range("B4", Sheets("DANH SACH TONG").Range("B65535").End(xlUp))
Set dRng = Sheets("FILE GUI").Range("B12", Sheets("FILE GUI").Range("B65535").End(xlUp))
 

File đính kèm

  • Khi co dong trong thi bi loi.xlsm
    54 KB · Đọc: 10
Upvote 0
Hi Ms. Oanh Thơ

Với Code này khi 1 trong 2 sheet có 1 dòng trống ở giữa thì file chỉ cho ra kết quả tới dòng trước dòng trống và dừng Code. Bạn có thể sửa cho Code chạy hết khi có dòng chống.
Tôi viết rất rõ
- Người viết code không được phép giả thiết là dữ liệu luôn liên tục, không có dòng trống. Dùng xlDown? Nếu 'DANH SACH TONG'!B7 = rỗng thì sau khi chạy GPE sẽ thiếu kết quả. Tương tự khi vd. 'FILE GUI'!B15 = rỗng
Bạn đã đọc vì
Mã:
Dạ, Hay quá
Thế bạn đọc có hiểu không mà vẫn cứ dùng xlDown? Bó tay.
 
Upvote 0
@Nguyễn Hoàng Oanh Thơ vậy code của bạn với PacificPR code nào tốt hơn ta?, mình thấy code đang xài vẫn ok chưa phat sinh gì, thấy mấy anh chị viết hoan mang quá.

Hi code của bạn PacificPR tốt hơn code của OT nhiều bạn à vì bạn ấy rất giỏi code.

Mà Oanh Thơ cũng không biết bạn đang sử dụng code nào của OT nữa, nếu bạn lấy code ở bài 12 thì yên tâm không bị lỗi như bài 34 ạ. Nếu bạn cảm thấy hoag mang thì có thể tạo dòng trống xen kẽ sau đó chạy code có thể biết được mà.

Bạn tham khảo thêm bài 29 nhé, có 2 cách cho bạn lựa chọn đó, lấy dữ liệu có cả format hoặc là chỉ value không.
 
Lần chỉnh sửa cuối:
Upvote 0
Hi code của bạn PacificPR tốt hơn code của OT nhiều bạn à vì bạn ấy rất giỏi code.

Mà Oanh Thơ cũng không biết bạn đang sử dụng code nào của OT nữa, nếu bạn lấy code ở bài 12 thì yên tâm không bị lỗi như bài 34 ạ. Nếu bạn cảm thấy hoag mang thì có thể tạo dòng trống xen kẽ sau đó chạy code có thể biết được mà.

Bạn tham khảo thêm bài 29 nhé, có 2 cách cho bạn lựa chọn đó, lấy dữ liệu có cả format hoặc là chỉ value không.
- OT ơi ! Bài 29 của anh Batman1 là cột B "FILE GUI" so sánh với cột B "DANH SACH TONG", giờ mình muốn sửa thành cột A "DANH SACH TONG" thì phải sửa khúc nào nhỉ :)
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom