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
Nếu là Hàm UDF trong VBA thì không thể áp dụng thay đổi màu sắc, định dạng format của cell
 
Upvote 0
-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ị ạ :(( )

Code ở bài này, bạn chưa dùng được ạ:
https://www.giaiphapexcel.com/diendan/threads/chuyên-đề-giải-đáp-những-thắc-mắc-về-code-vba.83698/page-86#post-895669
----------------
Oanh Thơ (OT) góp ý thêm: bạn đừng viết tắt nhé và đừng nửa tiếng Anh nửa tiếng Việt nhé, đại loại như:

Gửi lại bạn tập tin lần trước
 

File đính kèm

  • file.xlsm
    21.2 KB · Đọc: 26
Upvote 0
Code ở bài này, bạn chưa dùng được ạ:
https://www.giaiphapexcel.com/diendan/threads/chuyên-đề-giải-đáp-những-thắc-mắc-về-code-vba.83698/page-86#post-895669
----------------
Oanh Thơ (OT) góp ý thêm: bạn đừng viết tắt nhé và đừng nửa tiếng Anh nửa tiếng Việt nhé, đại loại như:


Gửi lại bạn tập tin lần trước
mình sẽ rút kinh nghiệm, giờ mình muốn sửa lại Sheep khác , cột khác thì phải sửa khúc nào trong code bạn :)
 
Upvote 0
Code ở bài này, bạn chưa dùng được ạ:
https://www.giaiphapexcel.com/diendan/threads/chuyên-đề-giải-đáp-những-thắc-mắc-về-code-vba.83698/page-86#post-895669
----------------
Oanh Thơ (OT) góp ý thêm: bạn đừng viết tắt nhé và đừng nửa tiếng Anh nửa tiếng Việt nhé, đại loại như:


Gửi lại bạn tập tin lần trước
Đạt chuẩn rồi đó.
Tiếp tục với "Sheep" đi. Khi bạn không còn "thấy" gì thì bạn sẽ không còn "sợ" gì.
 
Upvote 0
Trong Microsoft Excel lại có vụ vặt lông cừu sao?

Vấn đề của chủ thớt không phải là hàm u dờ ép nào cả, vấn đề ở chỗ thiết kế cấu trúc dữ liệu và cách ghi nhận dữ liệu.

Thay vì mỏi tay tô màu lòe loẹt, chèn ghi chú loằng nhoằng thì chèn thêm 3 cái cột nữa. Vậy có ngon lành như thịt cừu không?

[cột màu nền ô này] [cột ghi chú này] [cột màu chữ này]

Rồi vlookup() thì được xơi thịt cừu nướng.

---
Trường hợp dữ liệu đã có cần xử lý thì xử lý những thứ đó ghi ra 3 cột là giải quyết xong.
 
Upvote 0
Trong Microsoft Excel lại có vụ vặt lông cừu sao?

Vấn đề của chủ thớt không phải là hàm u dờ ép nào cả, vấn đề ở chỗ thiết kế cấu trúc dữ liệu và cách ghi nhận dữ liệu.

Thay vì mỏi tay tô màu lòe loẹt, chèn ghi chú loằng nhoằng thì chèn thêm 3 cái cột nữa. Vậy có ngon lành như thịt cừu không?

[cột màu nền ô này] [cột ghi chú này] [cột màu chữ này]

Rồi vlookup() thì được xơi thịt cừu nướng.

---
Trường hợp dữ liệu đã có cần xử lý thì xử lý những thứ đó ghi ra 3 cột là giải quyết xong.
em cũng muốn làm như vậy cho dễ bác ạ nhưng khổ cái file chính của em nó đã nhiều cột lắm rồi :(
 
Upvote 0
Excel (từ phiên bản 2007) có mười sáu ngàn ba trăm tám mươi bốn cột!
dạ ý em là file nhiều cột nhìn rối mắt ạ, anh có thể chỉ em cách thay thế cột khác và sheet khác trong code được không anh
Theo kiến thức cùi bắp của em mới đc học là

Sub FindAndCopyPase()
Dim lastRow As Long, i As Long, varKey As Variant
Dim c As Range, shtData As Worksheet, shtKQ As Worksheet
Set shtData = ThisWorkbook.Worksheets("Sheet2") //qui định shtdata là sheet2
Set shtKQ = ThisWorkbook.Worksheets("Sheet1") //qui định shtKQ là sheet1
With shtKQ
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row // tìm dòng cuối
varKey = .Range("A2:A" & lastRow) // vị trí ô bắt đầu được copy thì phải
End With
With shtData // còn phần này em bó tay :)
For i = LBound(varKey) To UBound(varKey)
Set c = .Columns("A").Find(What:=varKey(i, 1), _
After:=.Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlNext)
If c Is Nothing Then
shtKQ.Cells(i + 1, 2).Value = "#N/A"
Else
c.Resize(1, 2).Offset(0, 1).Copy Destination:=shtKQ.Cells(i + 1, 2)
End If
Next i
End With
End Sub
 
Upvote 0
mình sẽ rút kinh nghiệm, giờ mình muốn sửa lại Sheep khác , cột khác thì phải sửa khúc nào trong code bạn :)
Xin chào kienphamiuh,
Bạn điều chỉnh các tên sheet và tên cột trong Sub Chay_FindAndCopyPase nhé, những chỗ còn lại khoan vội để ý:
Mã:
Option Explicit
'Call FindAndCopyPase(ThamSo1, ThamSo2, ThamSo3, ThamSo4)
                    'ThamSo1:   Sheet 1
                    'ThamSo2:   Cot Chua tu khoa tim kiem trong sheet1
                    'ThamSo3:   Sheet 2
                    'ThamSo4:   Cot Chua tu khoa tim kiem trong sheet2

Sub Chay_FindAndCopyPase()
    Call FindAndCopyPase("Sheet1", "A", "Sheet2", "A")
End Sub

Sub FindAndCopyPase(shtKQ As String, colKeyKQ As String, shtData As String, colKeyData As String)

    Dim lastRow As Long, i As Long, varKey As Variant, c As Range
    Const dongdau As Integer = 2
    With Sheets(shtKQ)
        lastRow = .Range(colKeyKQ & .Rows.Count).End(xlUp).Row
        varKey = .Range(colKeyKQ & dongdau & ":" & colKeyKQ & lastRow)
    End With
    With Sheets(shtData)
        For i = LBound(varKey) To UBound(varKey)
            Set c = .Columns(colKeyData).Find(What:=varKey(i, 1), _
                After:=.Range(colKeyData & 1), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchDirection:=xlNext)
            If c Is Nothing Then
                Sheets(shtKQ).Cells(i + 1, 2).Value = "#N/A"
            Else
                c.Resize(1, 2).Offset(0, 1).Copy Destination:=Sheets(shtKQ).Cells(i + 1, 2)
            End If
        Next i
    End With
End Sub
 
Upvote 0
Bạn nhận xét rất đúng file ở bài #1.

Những gì là code, là công thức thì cho vào cái chỗ chuyên chứa nó.

View attachment 209072
anh giải thích giúp em đoạn code bạn Oanh viết được không ạ
Mã:
With shtData
For i = LBound(varKey) To UBound(varKey)
Set c = .Columns("A").Find(What:=varKey(i, 1), _
After:=.Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlNext)
If c Is Nothing Then
shtKQ.Cells(i + 1, 2).Value = "#N/A"
Else
c.Resize(1, 2).Offset(0, 1).Copy Destination:=shtKQ.Cells(i + 1, 2)
End If
Next i
End With
End Sub
 
Upvote 0
Đạt chuẩn rồi đó.
Tiếp tục với "Sheep" đi. Khi bạn không còn "thấy" gì thì bạn sẽ không còn "sợ" gì.

Xin chào thầy ạ :D
Bài đã được tự động gộp:

anh giải thích giúp em đoạn code bạn Oanh viết được không ạ
Mã:
With shtData
For i = LBound(varKey) To UBound(varKey)
Set c = .Columns("A").Find(What:=varKey(i, 1), _
After:=.Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlNext)
If c Is Nothing Then
shtKQ.Cells(i + 1, 2).Value = "#N/A"
Else
c.Resize(1, 2).Offset(0, 1).Copy Destination:=shtKQ.Cells(i + 1, 2)
End If
Next i
End With
End Sub

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
 
Lần chỉnh sửa cuối:
Upvote 0
Si tình thôi chứ ghê gớm gì.
tim khắc sâu ảnh em.
Chả thấy lôgíc gì cả. Vào GPE hỏi bài mà tự dưng "tim khắc sâu ảnh em" là thế nào bác? :D

Chắc đang yêu mê mệt nên buột miệng chăng?

Tôi cho là "Tớ không sành ăn ếch GPE". Đại loại là: "Tớ còn gà món ếch xào của GPE lắm, các ấy thông cảm cho nhé".
 
Upvote 0
Xin góp ý với chủ bài đăng 1 ý về mã HV (Học viên?) của bạn, như sau:
Mã HV của cả danh sách nên có độ dài bằng nhau; (Nhất là trong Excel tài lanh trong chuyện kí tự đại diện)
Ví dụ, ta nên bắt đầu mã HV từ 9999 cho HV đầu tiên trong danh sách
Chuyện bạn muốn trong bài đúng là không thể xài VLOOPKUP() hay udfVLOOKUP() nào được.
Họa chăng chỉ có thể là macro, nhưng chắc mệt lắm & xin báo trước là mình không thể đâu nha!
 
Upvote 0
Xin góp ý với chủ bài đăng 1 ý về mã HV (Học viên?) của bạn, như sau:
Mã HV của cả danh sách nên có độ dài bằng nhau; (Nhất là trong Excel tài lanh trong chuyện kí tự đại diện)
Ví dụ, ta nên bắt đầu mã HV từ 9999 cho HV đầu tiên trong danh sách
Chuyện bạn muốn trong bài đúng là không thể xài VLOOPKUP() hay udfVLOOKUP() nào được.
Họa chăng chỉ có thể là macro, nhưng chắc mệt lắm & xin báo trước là mình không thể đâu nha!
- Cảm ơn anh đã góp ý, nếu mã HV em viết thành ABC/0001 hoặc ABC/1762 có được không anh, vì " mã HV " sẽ nhỏ hơn 9999 .
- Như bài này nếu lúc mình dùng Function để tìm kiếm dựa vào " mã HV " sau đó dùng Sub/macro để lấy định dạng và comment thì có ổn không anh ?
 
Lần chỉnh sửa cuối:
Upvote 0
Xin chào kienphamiuh,
Bạn điều chỉnh các tên sheet và tên cột trong Sub Chay_FindAndCopyPase nhé, những chỗ còn lại khoan vội để ý:
Mã:
Option Explicit
'Call FindAndCopyPase(ThamSo1, ThamSo2, ThamSo3, ThamSo4)
                    'ThamSo1:   Sheet 1
                    'ThamSo2:   Cot Chua tu khoa tim kiem trong sheet1
                    'ThamSo3:   Sheet 2
                    'ThamSo4:   Cot Chua tu khoa tim kiem trong sheet2

Sub Chay_FindAndCopyPase()
    Call FindAndCopyPase("Sheet1", "A", "Sheet2", "A")
End Sub

Sub FindAndCopyPase(shtKQ As String, colKeyKQ As String, shtData As String, colKeyData As String)

    Dim lastRow As Long, i As Long, varKey As Variant, c As Range
    Const dongdau As Integer = 2
    With Sheets(shtKQ)
        lastRow = .Range(colKeyKQ & .Rows.Count).End(xlUp).Row
        varKey = .Range(colKeyKQ & dongdau & ":" & colKeyKQ & lastRow)
    End With
    With Sheets(shtData)
        For i = LBound(varKey) To UBound(varKey)
            Set c = .Columns(colKeyData).Find(What:=varKey(i, 1), _
                After:=.Range(colKeyData & 1), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchDirection:=xlNext)
            If c Is Nothing Then
                Sheets(shtKQ).Cells(i + 1, 2).Value = "#N/A"
            Else
                c.Resize(1, 2).Offset(0, 1).Copy Destination:=Sheets(shtKQ).Cells(i + 1, 2)
            End If
        Next i
    End With
End Sub

- Oanh Thơ hôm nay minh cho code vào file chính nhưng mình sửa code lại nó không chạy được, bạn coi giúp mình file này sửa code lại giúp mình với:
- Mục đích của file là lấy gia trị + màu sách+ comment của 2 cột ( I và J ) số điện thoại từ sheet " DANH SACH TONG " sang file " FILE GUI " cột ( J và K ) dựa vào cột MHV của " FILE GUI " để dò tim bên file " DANH SACH TONG "
- Bạn giải thích code cho mình hiểu với
đây là code mình sửa lại nhưng không chạy đuược
Mã:
Option Explicit
'Call FindAndCopyPase(ThamSo1, ThamSo2, ThamSo3, ThamSo4)
                    'ThamSo1:   Sheet 1
                    'ThamSo2:   Cot Chua tu khoa tim kiem trong sheet1
                    'ThamSo3:   Sheet 2
                    'ThamSo4:   Cot Chua tu khoa tim kiem trong sheet2

Sub Chay_FindAndCopyPase()
    Call FindAndCopyPase("FILE GUI", "B", "DANH SACH TONG", "A")
End Sub

Sub FindAndCopyPase(shtKQ As String, colKeyKQ As String, shtData As String, colKeyData As String)

    Dim lastRow As Long, i As Long, varKey As Variant, c As Range
    Const dongdau As Integer = 12
    With Sheets(shtKQ)
        lastRow = .Range(colKeyKQ & .Rows.Count).End(xlUp).Row
        varKey = .Range(colKeyKQ & dongdau & ":" & colKeyKQ & lastRow)
    End With
    With Sheets(shtData) 'minh khong biet sua phan nay sao cho dung
        For i = LBound(varKey) To UBound(varKey)
            Set c = .Columns(colKeyData).Find(What:=varKey(i, 1), _
                After:=.Range(colKeyData & 1), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchDirection:=xlNext)
            If c Is Nothing Then
                Sheets(shtKQ).Cells(i + 1, 2).Value = "#N/A"
            Else
                c.Resize(1, 2).Offset(0, 1).Copy Destination:=Sheets(shtKQ).Cells(i + 1, 2)
            End If
        Next i
    End With
End Sub
 

File đính kèm

  • file gửi thơ.xlsm
    52.6 KB · Đọc: 11
Upvote 0
- Oanh Thơ hôm nay minh cho code vào file chính nhưng mình sửa code lại nó không chạy được, bạn coi giúp mình file này sửa code lại giúp mình với:
- Mục đích của file là lấy gia trị + màu sách+ comment của 2 cột ( I và J ) số điện thoại từ sheet " DANH SACH TONG " sang file " FILE GUI " cột ( J và K ) dựa vào cột MHV của " FILE GUI " để dò tim bên file " DANH SACH TONG "
- Bạn giải thích code cho mình hiểu với
đây là code mình sửa lại nhưng không chạy đuược
Mã:
Option Explicit
'Call FindAndCopyPase(ThamSo1, ThamSo2, ThamSo3, ThamSo4)
                    'ThamSo1:   Sheet 1
                    'ThamSo2:   Cot Chua tu khoa tim kiem trong sheet1
                    'ThamSo3:   Sheet 2
                    'ThamSo4:   Cot Chua tu khoa tim kiem trong sheet2

Sub Chay_FindAndCopyPase()
    Call FindAndCopyPase("FILE GUI", "B", "DANH SACH TONG", "A")
End Sub

Sub FindAndCopyPase(shtKQ As String, colKeyKQ As String, shtData As String, colKeyData As String)

    Dim lastRow As Long, i As Long, varKey As Variant, c As Range
    Const dongdau As Integer = 12
    With Sheets(shtKQ)
        lastRow = .Range(colKeyKQ & .Rows.Count).End(xlUp).Row
        varKey = .Range(colKeyKQ & dongdau & ":" & colKeyKQ & lastRow)
    End With
    With Sheets(shtData) 'minh khong biet sua phan nay sao cho dung
        For i = LBound(varKey) To UBound(varKey)
            Set c = .Columns(colKeyData).Find(What:=varKey(i, 1), _
                After:=.Range(colKeyData & 1), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchDirection:=xlNext)
            If c Is Nothing Then
                Sheets(shtKQ).Cells(i + 1, 2).Value = "#N/A"
            Else
                c.Resize(1, 2).Offset(0, 1).Copy Destination:=Sheets(shtKQ).Cells(i + 1, 2)
            End If
        Next i
    End With
End Sub
Bạn sửa lại tiêu đề bài viết: Bỏ "tks ae GPE"
Sheet "DANH SACH TONG" làm gì có cột MHV?
Nếu cột B cả 2 sheet đều là MHV thì xem file này.
 

File đính kèm

  • CopyPaste.xlsm
    55.5 KB · Đọc: 42
Lần chỉnh sửa cuối:
Upvote 0
cảm ơn mọi người trong GPE đã giúp đỡ mình, nhất là bạn Oanh Thơ, mình đã dựa vào code của Oanh Thơ và sửa lại thành công rồi ạ, cảm ơn mọi người rất nhiều !!
Bài đã được tự động gộp:

Bạn sửa lại tiêu đề bài viết: Bỏ "tks ae GPE"
Sheet "DANH SACH TONG" làm gì có cột MHV?
Nếu cột B cả 2 sheet đều là MHV thì xem file này.
cảm ơn anh, code anh viết rất dễ hiểu và ngắn
 
Upvote 0
Web KT
Back
Top Bottom