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

[Datcdt2k9]

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

 

[HieuCD]

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

 

[Datcdt2k9]

Đ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: 22/10/21

Đ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: 22/10/21

Đ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

 

[HieuCD]

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: 22/10/21

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: 22/10/21

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

 

[SA_DQ]

Nếu cột A1 có các kí tự như trong cột (. . . .) thì trả về cột A2

Cột nào vậy bạn; đừng nói đó là cột L đó nghe!

 

[Datcdt2k9]

Ví dụ kết quả không như giải thích của bạn

Vâng, em chỉnh lại và đính kèm file bên dưới ạ

Bài đã được tự động gộp: 23/10/21

Cột nào vậy bạn; đừng nói đó là cột L đó nghe!

Vâng, em chỉnh lại file rõ ràng hơn rồi ạ

 

[HieuCD]

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: 23/10/21

Vâng, em chỉnh lại file rõ ràng hơn rồ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

 

[Datcdt2k9]

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

 

[HieuCD]

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

Ý mình hỏi tại sao có kết quả như hình

 

[HUONGHCKT]

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: 23/10/21

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

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

 

[Datcdt2k9]

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

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

 

[HUONGHCKT]

Đú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

 

[Datcdt2k9]

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

 

[HUONGHCKT]

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

 

[Datcdt2k9]

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

 

[HUONGHCKT]

ý 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

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.

 

[Datcdt2k9]

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

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é

 

[HUONGHCKT]

ok bạn, mình cảm ơn bạn nhé

Bạn đã thử code của mình chưa? kết quả thế nào?

 

[Datcdt2k9]

Bạn đã thử code của mình chưa? kết quả thế nào?

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 ạ.

 

[HUONGHCKT]

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.