[Cần giúp đỡ] Code VBA trả về giá trị tương ứng (1 người xem)

Liên hệ QC

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

Datcdt2k9

Thành viên hoạt động
Tham gia
27/12/19
Bài viết
109
Được thích
11
Chào mọi người
Em có file excel có các giá trị điều kiện, khi đúng điều kiện code sẽ trả về các giá trị tương ứng khi thảo mãn :
Nếu cột A1 có các kí tự như trong cột thì trả về cột A2
Nếu cột A3 có các kí tự như trong cột thì trả về cột A2
Nếu cột A2 có kí tự " Short* " thì trả về kí tự " GND " cột A2
Nếu cột A4 có kí tự " LKL* " thì trả về kí tự " GND " cột A2
(Dấu " *" ý nghĩa là còn các kí tự khác phía sau, chỉ cần tìm được các kí tự trước dấu *)
Mong mọi người giúp đỡ viết code VBA giúp mình do dữ liệu thực của mình số lượng dòng rất lớn nên dùng công thức thì rất nặng. Mình cảm ơn
1634916379258.png
 

File đính kèm

Chào mọi người
Em có file excel có các giá trị điều kiện, khi đúng điều kiện code sẽ trả về các giá trị tương ứng khi thảo mãn :
Nếu cột A1 có các kí tự như trong cột thì trả về cột A2
Nếu cột A3 có các kí tự như trong cột thì trả về cột A2
Nếu cột A2 có kí tự " Short* " thì trả về kí tự " GND " cột A2
Nếu cột A4 có kí tự " LKL* " thì trả về kí tự " GND " cột A2
(Dấu " *" ý nghĩa là còn các kí tự khác phía sau, chỉ cần tìm được các kí tự trước dấu *)
Mong mọi người giúp đỡ viết code VBA giúp mình do dữ liệu thực của mình số lượng dòng rất lớn nên dùng công thức thì rất nặng. Mình cảm ơn
View attachment 268167
Điều kiện và kết quả trả về quá huyền bí, bạn có thể giải mã rỏ và dể hiểu hơn
 
Điều kiện và kết quả trả về quá huyền bí, bạn có thể giải mã rỏ và dể hiểu hơn
Vâng, kết quả trả về cột A2 là giá trị tìm được tại cột A1, A3,A4 anh ạ
Bài đã được tự động gộp:

Điều kiện và kết quả trả về quá huyền bí, bạn có thể giải mã rỏ và dể hiểu hơn
Bình thường thì làm theo công thức chỉ cần dùng hàm left tách 3 kí tự đầu cột A1,khi dò được 3 giá trị đầu đó sẽ trả về giá trị như ô ở cột A2
Bài đã được tự động gộp:

Điều kiện và kết quả trả về quá huyền bí, bạn có thể giải mã rỏ và dể hiểu hơn
Bình thường thì làm theo công thức chỉ cần dùng hàm left tách 3 kí tự đầu,khi dò được 3 giá trị đầu đó sẽ trả về giá trị như ô ở cột A2
 
Lần chỉnh sửa cuối:
Vâng, kết quả trả về cột A2 là giá trị tìm được tại cột A1, A3,A4 anh ạ
Bài đã được tự động gộp:


Bình thường thì làm theo công thức chỉ cần dùng hàm left tách 3 kí tự đầu cột A1,khi dò được 3 giá trị đầu đó sẽ trả về giá trị như ô ở cột A2
Bài đã được tự động gộp:


Bình thường thì làm theo công thức chỉ cần dùng hàm left tách 3 kí tự đầu,khi dò được 3 giá trị đầu đó sẽ trả về giá trị như ô ở cột A2
Ví dụ kết quả không như giải thích của bạn
 

File đính kèm

Lần chỉnh sửa cuối:
Kết quả vẫn còn "bí huyền"
GA*ANT
LED*ANT
SOC*LKL
HDC*LKL
OSC*LKL
SUS*SC
CLP*SC
Vâng, thực tế em đang làm thủ công lọc ra những dòng có kí tự như ô A1 rồi điền giá trị tương ứng như ô A2,dữ liệu dòng nhiều nên làm thủ công mất nhiều thời gian
 
Vâng, em chỉnh lại và đính kèm file bên dưới ạ
View attachment 268200
Bài đã được tự động gộp:


Vâng, em chỉnh lại file rõ ràng hơn rồi ạ
Làm theo ý hiểu của bản thân.
Lập thêm 1 bảng tra, ở sh khác hoặc trong Sh đó
Đúng, sai - hên, sui
Mã:
Sub THU()
Dim i&, j&, Lr&, R&, C&
Dim Arr(), ArrBtra(), KQ()
Set RngB = Sheets("Btra").Range("A1").CurrentRegion
ArrBtra = Sheets("Btra").Range("A1:B" & RngB.Rows.Count).Value
With Sheets("DL")
Set Rng = .Range("C2").CurrentRegion
Lr = Rng.Rows.Count
Arr = .Range("C3:F" & Lr).Value
R = UBound(Arr): C = UBound(Arr, 2)
ReDim KQ(1 To R, 1 To 1)
For i = 1 To R
    For j = 1 To C
        If Arr(i, j) <> Empty Then
            For k = 1 To UBound(ArrBtra)
                If Ucase(Arr(i, j)) Like ArrBtra(k, 1) & "*" Then
                    KQ(i, 1) = ArrBtra(k, 2)
                End If
            Next k
        End If
    Next j
Next i
.Range("I3").Resize(i, 1).ClearContents
.Range("I3").Resize(i - 1, 1) = KQ
End With
MsgBox "Xong", vbInformation, "THÔNG BÁO"
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Làm theo ý hiểu của bản thân.
Lập thêm 1 bảng tra, ở sh khác hoặc trong Sh đó
Đúng, sai - hên, sui
Mã:
Sub THU()
Dim i&, j&, Lr&, R&, C&
Dim Arr(), ArrBtra(), KQ()
Set RngB = Sheets("Btra").Range("A1").CurrentRegion
ArrBtra = Sheets("Btra").Range("A1:B" & RngB.Rows.Count).Value
With Sheets("DL")
Set Rng = .Range("C2").CurrentRegion
Lr = Rng.Rows.Count
Arr = .Range("C3:F" & Lr).Value
R = UBound(Arr): C = UBound(Arr, 2)
ReDim KQ(1 To R, 1 To 1)
For i = 1 To R
    For j = 1 To C
        If Arr(i, j) <> Empty Then
            For k = 1 To UBound(ArrBtra)
                If Ucase(Arr(i, j)) Like ArrBtra(k, 1) & "*" Then
                    KQ(i, 1) = ArrBtra(k, 2)
                End If
            Next k
        End If
    Next j
Next i
.Range("I3").Resize(i, 1).ClearContents
.Range("I3").Resize(i - 1, 1) = KQ
End With
MsgBox "Xong", vbInformation, "THÔNG BÁO"
End Sub
Đúng ý mình rồi bạn ạ nhưng mình chỉnh sửa thu gọn lại 1 bảng như file bên dưới và mình đang gặp là dữ liệu khi cách nhau khoảng trống thì code không tách được, bạn chỉnh giúp mình ạ, dữ liệu sẽ nằm không liên tục trên các dòng, nhấn run như ảnh dưới thì code không tách được
1635036342936.png
 

File đính kèm

Đúng ý mình rồi bạn ạ nhưng mình chỉnh sửa thu gọn lại 1 bảng như file bên dưới và mình đang gặp là dữ liệu khi cách nhau khoảng trống thì code không tách được, bạn chỉnh giúp mình ạ, dữ liệu sẽ nằm không liên tục trên các dòng, nhấn run như ảnh dưới thì code không tách được
View attachment 268212
Set Rng = .Range("H2").CurrentRegion là để chọn 1 vùng liên lục không có dòng trống bắt đầu từ ô H2. Tôi muốn dùng vùng Rng để tìm số dòng cuối của vùng có dữ liệu có số dòng cuối của cột có dữ liệu nên mới đưa .Currentregion vào .
Còn nếu đã xác định được vùng cần tham chiếu để lấy giá trị (Trong trường hợp số dòng cuối của cột có dữ liệu không bằng nhau và dữ liệu không liên tục). Thì bạn vào code sửa trực tiếp trên code chỗ Arr=Range(....) thành Arr=Range(Ô đầu tiên: Ô cuối cùng của vùng dũ liệu cần tham chiếu) , nhớ vô hiệu hoặc xóa bỏ dòng Set Rng =.... và dòng Lr=...
Còn vẫn muốn để vùng tham chiếu co giãn thì sử dụng cách tìm dòng cuối có dữ liệu (Lr=Sheets("tên Sheet").Range("Cột có dòng cuối có dữ liệu, rows.Count) .end(xlup).row). khi ta thêm vào Cột đó và chạy code thì vẫn đúng.
Tóm lại là bạn tìm cách nào đó để tìm được dòng cuối có dữ liệu (tạm đặt biến là Lr) để xác định vùng tham chiếu (mảng Arr). Khi lấy tham số ấy để xác định kích thước mảng Arr bằng cách Arr=Range("Ô đầu tiên (vd: "C3": Ô cuối cùng của vùng dũ liệu cần tham chiếu (vd: G"&lr).value
Bạn xem file
 

File đính kèm

Set Rng = .Range("H2").CurrentRegion là để chọn 1 vùng liên lục không có dòng trống bắt đầu từ ô H2. Tôi muốn dùng vùng Rng để tìm số dòng cuối của vùng có dữ liệu có số dòng cuối của cột có dữ liệu nên mới đưa .Currentregion vào .
Còn nếu đã xác định được vùng cần tham chiếu để lấy giá trị (Trong trường hợp số dòng cuối của cột có dữ liệu không bằng nhau và dữ liệu không liên tục). Thì bạn vào code sửa trực tiếp trên code chỗ Arr=Range(....) thành Arr=Range(Ô đầu tiên: Ô cuối cùng của vùng dũ liệu cần tham chiếu) , nhớ vô hiệu hoặc xóa bỏ dòng Set Rng =.... và dòng Lr=...
Còn vẫn muốn để vùng tham chiếu co giãn thì sử dụng cách tìm dòng cuối có dữ liệu (Lr=Sheets("tên Sheet").Range("Cột có dòng cuối có dữ liệu, rows.Count) .end(xlup).row). khi ta thêm vào Cột đó và chạy code thì vẫn đúng.
Tóm lại là bạn tìm cách nào đó để tìm được dòng cuối có dữ liệu (tạm đặt biến là Lr) để xác định vùng tham chiếu (mảng Arr). Khi lấy tham số ấy để xác định kích thước mảng Arr bằng cách Arr=Range("Ô đầu tiên (vd: "C3": Ô cuối cùng của vùng dũ liệu cần tham chiếu (vd: G"&lr).value
Bạn xem file
Dữ liệu của mình có số dòng thay đổi nên dòng cuối cũng thay đổi nên không xác định được dòng cuối chính xác. Mình muốn để vùng tham chiếu co giãn để xác định dòng cuối khi dữ liệu thay đổi và các dòng dữ liệu của mình có thể nằm liên tục(cách nhau khoảng trắng hoặc các khoảng có kí tự khác kí tự yêu cầu) mà code vẫn tách ra được.Mình không rành về code VBA. Mong bạn giúp
 
Dữ liệu của mình có số dòng thay đổi nên dòng cuối cũng thay đổi nên không xác định được dòng cuối chính xác. Mình muốn để vùng tham chiếu co giãn để xác định dòng cuối khi dữ liệu thay đổi và các dòng dữ liệu của mình có thể nằm liên tục(cách nhau khoảng trắng hoặc các khoảng có kí tự khác kí tự yêu cầu) mà code vẫn tách ra được.Mình không rành về code VBA. Mong bạn giúp
Như đã nói ở bài trước. vấn đề là tìm được dòng cuối có dữ liệu của vùng tham chiếu. Bạn dùng Set Rng =.........CurrentRegion sau đó là Lr=Rng.rows.count ; hay Lr=Sh....Range("....",rows.count).end(xlUp).row, và các cách khác nữa (bạn có thể tìm trên mạng các cách này) là tùy thuộc và mỗi bài cụ thể. tôi nghĩ là không có cách tổng quát cho tất cả các trường hợp
Còn với dữ liệu không thật chuẩn( thừa khoảng trắng, viết hoa-không viết hoa, hoặc ký tự cần lấy nằm ở trong chuỗi lớn ) thì có thể vẫn lấy được tuy nhiên đọ sai, sót có thể sẽ có.
1/Để triệt tiêu khoảng trắng vô nghĩa (trước và sau chuỗi) ta sử dụng hàm Trim-hàm này VBA có trong thư viên của VBA . ta thay If Ucase(Arr(i, j)) like.... bằng If Ucase(Trim(arr(i,j))) like....
2/Để xử lý viết hoa không viết hoa thì Ucase( Arr(i,j) đã giải quyết
3/Để tìm ký tự nằm trong chuỗi lớn (không phải nằm 2 đầu) bằng cách sử dụng ký tự đại diện . Ta thay like ArrBtra(k,1)& "*" then Bằng .... like "*"& ArrBtra(k,1)&"*" then
4/ Tổng hợp cả 3 trường hợp trên sẽ thành If Ucase(trim(Arr(i,j)) like "*" & ArrBtra(k,1)&"*" then
Tùy tình huống mà bạn sử dụng phù hợp
 
Như đã nói ở bài trước. vấn đề là tìm được dòng cuối có dữ liệu của vùng tham chiếu. Bạn dùng Set Rng =.........CurrentRegion sau đó là Lr=Rng.rows.count ; hay Lr=Sh....Range("....",rows.count).end(xlUp).row, và các cách khác nữa (bạn có thể tìm trên mạng các cách này) là tùy thuộc và mỗi bài cụ thể. tôi nghĩ là không có cách tổng quát cho tất cả các trường hợp
Còn với dữ liệu không thật chuẩn( thừa khoảng trắng, viết hoa-không viết hoa, hoặc ký tự cần lấy nằm ở trong chuỗi lớn ) thì có thể vẫn lấy được tuy nhiên đọ sai, sót có thể sẽ có.
1/Để triệt tiêu khoảng trắng vô nghĩa (trước và sau chuỗi) ta sử dụng hàm Trim-hàm này VBA có trong thư viên của VBA . ta thay If Ucase(Arr(i, j)) like.... bằng If Ucase(Trim(arr(i,j))) like....
2/Để xử lý viết hoa không viết hoa thì Ucase( Arr(i,j) đã giải quyết
3/Để tìm ký tự nằm trong chuỗi lớn (không phải nằm 2 đầu) bằng cách sử dụng ký tự đại diện . Ta thay like ArrBtra(k,1)& "*" then Bằng .... like "*"& ArrBtra(k,1)&"*" then
4/ Tổng hợp cả 3 trường hợp trên sẽ thành If Ucase(trim(Arr(i,j)) like "*" & ArrBtra(k,1)&"*" then
Tùy tình huống mà bạn sử dụng phù hợp
ý mình là dữ liệu nó không liên tục trong cột A1 như trong ví dụ bạn ạ.Cột A1 dữ liệu không liên tục ( 2 chữ bga trong cột A1 cách nhau một dòng trống, 2 chữ bga và ant cách nhau 3 khoảng trống và khi xuất hiện khoảng trống này thì code không tách
1635054871097.png
 

File đính kèm

ý mình là dữ liệu nó không liên tục trong cột A1 như trong ví dụ bạn ạ.Cột A1 dữ liệu không liên tục ( 2 chữ bga trong cột A1 cách nhau một dòng trống, 2 chữ bga và ant cách nhau 3 khoảng trống và khi xuất hiện khoảng trống này thì code không tách
View attachment 268238
Vấn đề tôi đã nói là tìm được dòng cuối có dữ liệu để xác định được vùng tham chiếu.
Rất khó để làm tổng quát vấn đề này, tùy thuộc vào người sử dụng code thôi. Chứ còn để nó đúng cho mọi trường hợp (kể cả dữ liệu chuẩn hay không chuẩn ) thì có lẽ bạn hỏi cả các chuyên gia của Mr Bill cũng bó tay. Dữ liệu nó ngắt quãng không liên tục như vậy thì bạn nhìn vào và biết dòng cuối cùng có dữ liệu là dòng nào chứ. Và có thể mở code ra và thay vào chỉ số kích thước cho mảng tham chiếu.

Tôi sửa lại code cho bạn theo hướng tổng quát (không phải mở code ra), bạn xem và cố hiểu nhé.
Chỗ đoạn
Set goctren = .Range("A2")
Set gocduoi = .Range("A3")
Arr = .Range(goctren & ":" & gocduoi).Value

Mã:
Sub THU()
Dim i&, j&, Lr&, R&, C&
Dim Arr(), ArrBtra(), KQ()
Dim RngB As Range, goctren As Range, gocduoi As Range
Set RngB = Sheets("Btra").Range("A1").CurrentRegion
ArrBtra = Sheets("Btra").Range("A1:B" & RngB.Rows.Count).Value
With Sheets("DL")
'Set Rng = .Range("H2").CurrentRegion
'Lr = Rng.Rows.Count
Set goctren = .Range("A2")
Set gocduoi = .Range("A3")
Arr = .Range(goctren & ":" & gocduoi).Value

'Arr = .Range("D3:G" & Lr).Value
R = UBound(Arr): C = UBound(Arr, 2)
ReDim KQ(1 To R, 1 To 1)
For i = 1 To R
    For j = 1 To C
        If Arr(i, j) <> Empty Then
            For k = 1 To UBound(ArrBtra)
               If UCase(Trim(Arr(i, j))) Like ArrBtra(k, 1) & "*" Then
                    KQ(i, 1) = ArrBtra(k, 2)
                End If
            Next k
        End If
    Next j
Next i
.Range("E3").Resize(i, 1).ClearContents
.Range("E3").Resize(i - 1, 1) = KQ
End With
MsgBox "Xong", vbInformation, "THÔNG BÁO"
End Sub
Còn không muốn mở code ra sửa thì bạn làm gì? Chờ người khác mở ra sửa cho bạn chăng? Có thể sẽ rất lâu mới có người làm sẵn cho bạn.
 
Vấn đề tôi đã nói là tìm được dòng cuối có dữ liệu để xác định được vùng tham chiếu.
Rất khó để làm tổng quát vấn đề này, tùy thuộc vào người sử dụng code thôi. Chứ còn để nó đúng cho mọi trường hợp (kể cả dữ liệu chuẩn hay không chuẩn ) thì có lẽ bạn hỏi cả các chuyên gia của Mr Bill cũng bó tay. Dữ liệu nó ngắt quãng không liên tục như vậy thì bạn nhìn vào và biết dòng cuối cùng có dữ liệu là dòng nào chứ. Và có thể mở code ra và thay vào chỉ số kích thước cho mảng tham chiếu.

Tôi sửa lại code cho bạn theo hướng tổng quát (không phải mở code ra), bạn xem và cố hiểu nhé.
Chỗ đoạn
Set goctren = .Range("A2")
Set gocduoi = .Range("A3")
Arr = .Range(goctren & ":" & gocduoi).Value

Mã:
Sub THU()
Dim i&, j&, Lr&, R&, C&
Dim Arr(), ArrBtra(), KQ()
Dim RngB As Range, goctren As Range, gocduoi As Range
Set RngB = Sheets("Btra").Range("A1").CurrentRegion
ArrBtra = Sheets("Btra").Range("A1:B" & RngB.Rows.Count).Value
With Sheets("DL")
'Set Rng = .Range("H2").CurrentRegion
'Lr = Rng.Rows.Count
Set goctren = .Range("A2")
Set gocduoi = .Range("A3")
Arr = .Range(goctren & ":" & gocduoi).Value

'Arr = .Range("D3:G" & Lr).Value
R = UBound(Arr): C = UBound(Arr, 2)
ReDim KQ(1 To R, 1 To 1)
For i = 1 To R
    For j = 1 To C
        If Arr(i, j) <> Empty Then
            For k = 1 To UBound(ArrBtra)
               If UCase(Trim(Arr(i, j))) Like ArrBtra(k, 1) & "*" Then
                    KQ(i, 1) = ArrBtra(k, 2)
                End If
            Next k
        End If
    Next j
Next i
.Range("E3").Resize(i, 1).ClearContents
.Range("E3").Resize(i - 1, 1) = KQ
End With
MsgBox "Xong", vbInformation, "THÔNG BÁO"
End Sub
Còn không muốn mở code ra sửa thì bạn làm gì? Chờ người khác mở ra sửa cho bạn chăng? Có thể sẽ rất lâu mới có người làm sẵn cho bạn.
ok bạn, mình cảm ơn bạn nhé
 
Trường hợp tổng quát mình thử rồi nhưng bị lỗi không chạy được bạn ạ.

View attachment 268244
Bạn không thêm chỉ số cho mảng thì làm sao mà nó chẳng báo lỗi.
Chỉ sô cho mảng tham chiếu (vùng dữ liệu) được đặt trong 2 ô A2 và A3 bạn nhìn trong code có dòng này không?
Set goctren = .Range("A2")
Set gocduoi = .Range("A3")
Arr = .Range(goctren & ":" & gocduoi).Value

bạn xem hình tôi thêm A2=D3; A3=G16 và chạy code. Bạn cũng thêm vào A2,A3 như trong hình và chạy code thử xem.
 

File đính kèm

  • Screenshot (43).png
    Screenshot (43).png
    291.8 KB · Đọc: 8
Bạn không thêm chỉ số cho mảng thì làm sao mà nó chẳng báo lỗi.
Chỉ sô cho mảng tham chiếu (vùng dữ liệu) được đặt trong 2 ô A2 và A3 bạn nhìn trong code có dòng này không?
Set goctren = .Range("A2")
Set gocduoi = .Range("A3")
Arr = .Range(goctren & ":" & gocduoi).Value

bạn xem hình tôi thêm A2=D3; A3=G16 và chạy code. Bạn cũng thêm vào A2,A3 như trong hình và chạy code thử xem.
Mình thử code ok rồi bạn, cho mình hỏi cái vùng: Arr = .Range("C3:F" & Lr).Value ví dụ mình muốn chọn nhiều vùng chi tiết trong vùng C3:F ví dụ là vùng C3, Vùng E3:F ( bỏ qua vùng D3) thì cần chỉnh code như thế nào bạn ?
 
Lần chỉnh sửa cuối:
Mình thử code ok rồi bạn, cho mình hỏi cái vùng: Arr = .Range("C3:F" & Lr).Value ví dụ mình muốn chọn nhiều vùng chi tiết trong vùng C3:F ví dụ là vùng C3, Vùng E3:F ( bỏ qua vùng D3) thì cần chỉnh code như thế nào bạn ?
tạm hiểu là vùng (mảng) là một hình chữ nhật (hoặc hình vuông) có góc trên và góc dưới. bạn cứ thay vị trí 2 góc đó vào 2 ô A2,A3 và chạy thử code thì sẽ thấy.
 
tạm hiểu là vùng (mảng) là một hình chữ nhật (hoặc hình vuông) có góc trên và góc dưới. bạn cứ thay vị trí 2 góc đó vào 2 ô A2,A3 và chạy thử code thì sẽ thấy.
2 ô A2,A3 thì chỉ chọn được 1 vùng, mình muốn chọn đồng thời các vùng C3 và E3:F thì code chỉnh thế nào bạn
 
2 ô A2,A3 thì chỉ chọn được 1 vùng, mình muốn chọn đồng thời các vùng C3 và E3:F thì code chỉnh thế nào bạn
Thì bạn ngâm cứu phương thức UNION()
Ví dụ:
PHP:
Sub ChonNhieuVung()
 Dim Rng As Range

 Set Rng = Union([C3].CurrentRegion, [E3].CurrentRegion)
 MsgBox Rng.Address
End Sub
 
2 ô A2,A3 thì chỉ chọn được 1 vùng, mình muốn chọn đồng thời các vùng C3 và E3:F thì code chỉnh thế nào bạn
Có phải ý của bạn là có 2 hoặc nhiều hơn vùng tham chiếu nằm cách quãng nhau phải không? Nhưng là 1 Mảng kết quả , hay là nhiều mảng kết quả tương ứng?
 
Có phải ý của bạn là có 2 hoặc nhiều hơn vùng tham chiếu nằm cách quãng nhau phải không? Nhưng là 1 Mảng kết quả , hay là nhiều mảng kết quả tương ứng?
Ừ ý của mình là có 2 hoặc nhiều hơn 2 vùng tham chiều nằm cách quãng nhau, trả về 1 mảng kết quả như ban đầu trong cột A2 ,tùy vào mình sử dụng mà sẽ chọn những vùng nào, như trong bài khi code tìm được trong bảng Btra có các kí tự đó sẽ ghi kết quả tương ứng trong cột A2, nếu để vùng tham chiếu rộng từ C3:F có những cột vẫn chứa kí tự như trong cột Btra nhưng mình không muốn code dò tìm trong cột đó
 
Ừ ý của mình là có 2 hoặc nhiều hơn 2 vùng tham chiều nằm cách quãng nhau, trả về 1 mảng kết quả như ban đầu trong cột A2 ,tùy vào mình sử dụng mà sẽ chọn những vùng nào, như trong bài khi code tìm được trong bảng Btra có các kí tự đó sẽ ghi kết quả tương ứng trong cột A2, nếu để vùng tham chiếu rộng từ C3:F có những cột vẫn chứa kí tự như trong cột Btra nhưng mình không muốn code dò tìm trong cột đó
Nếu vậy Thì bạn cứ lấy Mảng tham chiếu theo chỉ số trong ô A2,A3 (mảng này sẽ chứa cả những cột không muốn tham chiếu (ví dụ cột không muốn thamn chiếu là cột F tức là cột số 4 trong mảng Arr(C3:G16) có 5 cột . Sau đó trong vòng lặp chạy và bỏ qua cột không muốn ấy bằng cách
For i = 1 to R
For j = 1 To C
If j=4 then goto tiep
.......
......
tiep:
next j
next i
Bạn xem code
Mã:
Sub THU()
Dim i&, j&, Lr&, R&, C&
Dim Arr(), ArrBtra(), KQ()
Dim RngB As Range, goctren As Range, gocduoi As Range
Set RngB = Sheets("Btra").Range("A1").CurrentRegion
ArrBtra = Sheets("Btra").Range("A1:B" & RngB.Rows.Count).Value
With Sheets("DL")
'Set Rng = .Range("H2").CurrentRegion
'Lr = Rng.Rows.Count
Set goctren = .Range("A2")
Set gocduoi = .Range("A3")
Arr = .Range(goctren & ":" & gocduoi).Value

R = UBound(Arr): C = UBound(Arr, 2)
ReDim KQ(1 To R, 1 To 1)
For i = 1 To R
    For j = 1 To C
    If j = 4 Then GoTo tiêp
        If Arr(i, j) <> Empty Then
            For k = 1 To UBound(ArrBtra)
               If UCase(Trim(Arr(i, j))) Like ArrBtra(k, 1) & "*" Then
                    KQ(i, 1) = ArrBtra(k, 2)
               End If
            Next k
        End If
tiêp:
    Next j
Next i
.Range("E3").Resize(i, 1).ClearContents
.Range("E3").Resize(i - 1, 1) = KQ
End With
MsgBox "Xong", vbInformation, "THÔNG BÁO"
End Sub
Hãy thử copy code trên và chạy thử.
 
Nếu vậy Thì bạn cứ lấy Mảng tham chiếu theo chỉ số trong ô A2,A3 (mảng này sẽ chứa cả những cột không muốn tham chiếu (ví dụ cột không muốn thamn chiếu là cột F tức là cột số 4 trong mảng Arr(C3:G16) có 5 cột . Sau đó trong vòng lặp chạy và bỏ qua cột không muốn ấy bằng cách
For i = 1 to R
For j = 1 To C
If j=4 then goto tiep
.......
......
tiep:
next j
next i
Bạn xem code
Mã:
Sub THU()
Dim i&, j&, Lr&, R&, C&
Dim Arr(), ArrBtra(), KQ()
Dim RngB As Range, goctren As Range, gocduoi As Range
Set RngB = Sheets("Btra").Range("A1").CurrentRegion
ArrBtra = Sheets("Btra").Range("A1:B" & RngB.Rows.Count).Value
With Sheets("DL")
'Set Rng = .Range("H2").CurrentRegion
'Lr = Rng.Rows.Count
Set goctren = .Range("A2")
Set gocduoi = .Range("A3")
Arr = .Range(goctren & ":" & gocduoi).Value

R = UBound(Arr): C = UBound(Arr, 2)
ReDim KQ(1 To R, 1 To 1)
For i = 1 To R
    For j = 1 To C
    If j = 4 Then GoTo tiêp
        If Arr(i, j) <> Empty Then
            For k = 1 To UBound(ArrBtra)
               If UCase(Trim(Arr(i, j))) Like ArrBtra(k, 1) & "*" Then
                    KQ(i, 1) = ArrBtra(k, 2)
               End If
            Next k
        End If
tiêp:
    Next j
Next i
.Range("E3").Resize(i, 1).ClearContents
.Range("E3").Resize(i - 1, 1) = KQ
End With
MsgBox "Xong", vbInformation, "THÔNG BÁO"
End Sub
Hãy thử copy code trên và chạy thử.
Mình tạo lại bảng và chỉnh code theo bảng dưới nhưng bạn chỉnh giúp mình sao cho khi chạy code vẫn đổi như trong bảng tra nhưng những kí tự không thuộc bảng tra trong cột (Package, Short) không bị xóa đi, các kí tự có trong bảng tra vẫn xuất ra bình thường.

1635172622165.png
 

File đính kèm

Lần chỉnh sửa cuối:
Mình tạo lại bảng và chỉnh code theo bảng dưới nhưng bạn chỉnh giúp mình sao cho khi chạy code vẫn đổi như trong bảng tra nhưng những kí tự không thuộc bảng tra trong cột (Package, Short) không bị xóa đi, các kí tự có trong bảng tra vẫn xuất ra bình thường.

View attachment 268292
Khi code chạy nó sẽ lấy từng phần tử (arr(i,j)) trong mảng Tham chiếu Arr (vùng A5:AG300) nếu phần tử đó không rỗng Arr(i,j)<> empty thì tiếp tục lấy từng phần tử trong mảng ArrBtra(i,j) (các ký tự đầu) để so sánh với Arr(i,j), nếu trùng thì lấy phần tử cột 2 trong mảng ArrBtra(k,2) để ghi vào mảng kết quả KQ(i,1), sau khi duyệt xong hết các phần tử của mảng tham chiếu Arr ta được một mảng kết quả và đem gán mảng kết quả này xuống Sheet.
Nếu bạn muốn giữ nguyên các giá trị thì chỉ còn cách không dùng mảng kết quả mà cứ duyệt xong Cells(i,j) trong vùng tham chiếu là gán luôn kết quả tìm được trong ArrBtra vào Sheet .cells(i,4)=ArrBtra(k,2)
Bạn nên tìm hiểu thêm về Array .
 

File đính kèm

Khi code chạy nó sẽ lấy từng phần tử (arr(i,j)) trong mảng Tham chiếu Arr (vùng A5:AG300) nếu phần tử đó không rỗng Arr(i,j)<> empty thì tiếp tục lấy từng phần tử trong mảng ArrBtra(i,j) (các ký tự đầu) để so sánh với Arr(i,j), nếu trùng thì lấy phần tử cột 2 trong mảng ArrBtra(k,2) để ghi vào mảng kết quả KQ(i,1), sau khi duyệt xong hết các phần tử của mảng tham chiếu Arr ta được một mảng kết quả và đem gán mảng kết quả này xuống Sheet.
Nếu bạn muốn giữ nguyên các giá trị thì chỉ còn cách không dùng mảng kết quả mà cứ duyệt xong Cells(i,j) trong vùng tham chiếu là gán luôn kết quả tìm được trong ArrBtra vào Sheet .cells(i,4)=ArrBtra(k,2)
Bạn nên tìm hiểu thêm về Array .
Cảm ơn bạn, Khi mình chỉ cho code chạy trong các cột bôi vàng, cột bôi xanh là các cột mà mình không muốn code chạy vào đó vì có thể có các kí tự giống trong Btra nên kết quả nếu code chạy trong các cột xanh đó thì kết quả sẽ không còn đúng mà nếu như nhập các cột không muốn code chạy vào: If j = 4 Or j = 34 Then GoTo tiêp như trong bài thì trong trường hợp của mình sẽ từ cột 6 tới cột 33 sẽ Or rất dài.

1635256583589.png
 

File đính kèm

Cảm ơn bạn, Khi mình chỉ cho code chạy trong các cột bôi vàng, cột bôi xanh là các cột mà mình không muốn code chạy vào đó vì có thể có các kí tự giống trong Btra nên kết quả nếu code chạy trong các cột xanh đó thì kết quả sẽ không còn đúng mà nếu như nhập các cột không muốn code chạy vào: If j = 4 Or j = 34 Then GoTo tiêp như trong bài thì trong trường hợp của mình sẽ từ cột 6 tới cột 33 sẽ Or rất dài.

View attachment 268364
Nếu các cột liền nhau không cách quãng (ví dụ: 6 34 chứ không là 6,7,10,11,13
thì bạn dùng If J>= 6 and I<= 34 then goto tiep,
Nếu các cột cách quãng thì bạn có thể dùng mảng 1 chiều ( ví dụ: cot=Arrray(6,7,10,11,13...)để ghi lại các côt mà code sẽ bỏ qua, khi ấy code sẽ phải thêm một vòng lặp để duyệt các phần tử của mảng cot, khi j = phân tử của mảng cot ấy sẽ bỏ qua.
......
For j=1 to C
For k= 0 to Ubound(cot)
If j=cot(k) then goto tiep
........
end if
next k
next j
......

nếu bạn không muốn mở Code để sửa thì có thể ghi lại các cột bị bỏ qua ây vào trên sh và dùng hàm split để ghi vào mảng cot ( ví dụ cot = Split(Sheet1.range("A4"), ", ") )
Chúc bạn thành công.
 

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

Back
Top Bottom