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

Tham gia ngày
8 Tháng mười hai 2018
Bài viết
39
Thích
9
Điểm
15
Tuổi
24
#22
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

Tham gia ngày
1 Tháng mười một 2017
Bài viết
18
Thích
0
Điểm
163
Tuổi
38
#23
- 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
 
Tham gia ngày
8 Tháng mười hai 2018
Bài viết
39
Thích
9
Điểm
15
Tuổi
24
#24
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 ?
 

Ba Tê

Cạo Rồi Khỏi Gội
Tham gia ngày
5 Tháng năm 2009
Bài viết
10,450
Thích
14,724
Điểm
1,560
Tuổi
59
#25
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

Nguyentu95

Thành viên mới
Tham gia ngày
31 Tháng mười hai 2018
Bài viết
7
Thích
0
Điểm
13
Tuổi
24
#27
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
 
Tham gia ngày
5 Tháng mười một 2015
Bài viết
762
Thích
239
Điểm
235
#28
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.
 

batman1

Thành viên tích cực
Tham gia ngày
8 Tháng chín 2014
Bài viết
1,383
Thích
2,211
Điểm
360
#29
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
 
Tham gia ngày
5 Tháng mười một 2015
Bài viết
762
Thích
239
Điểm
235
#30
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.
 

batman1

Thành viên tích cực
Tham gia ngày
8 Tháng chín 2014
Bài viết
1,383
Thích
2,211
Điểm
360
#31

Nguyentu95

Thành viên mới
Tham gia ngày
31 Tháng mười hai 2018
Bài viết
7
Thích
0
Điểm
13
Tuổi
24
#32
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

Nguyentu95

Thành viên mới
Tham gia ngày
31 Tháng mười hai 2018
Bài viết
7
Thích
0
Điểm
13
Tuổi
24
#33
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!
 

Nguyentu95

Thành viên mới
Tham gia ngày
31 Tháng mười hai 2018
Bài viết
7
Thích
0
Điểm
13
Tuổi
24
#34
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

PacificPR

Thành viên tích cực
Tham gia ngày
12 Tháng tư 2017
Bài viết
1,237
Thích
1,886
Điểm
360
#35
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

batman1

Thành viên tích cực
Tham gia ngày
8 Tháng chín 2014
Bài viết
1,383
Thích
2,211
Điểm
360
#36
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.
 

Nguyentu95

Thành viên mới
Tham gia ngày
31 Tháng mười hai 2018
Bài viết
7
Thích
0
Điểm
13
Tuổi
24
#37
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))
Cảm ơn Bác Nhiều!
 
Tham gia ngày
5 Tháng mười một 2015
Bài viết
762
Thích
239
Điểm
235
#39
@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:

kienphamiuh

Thành viên mới
Tham gia ngày
8 Tháng mười hai 2018
Bài viết
39
Thích
9
Điểm
15
Tuổi
24
#40
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:
Top