[Cần giúp đỡ] Code VBA trả về giá trị tương ứng

Blue Softs epl Liên hệ QC

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

  • Tra ve gia tri tuong ung.xlsm
    10.7 KB · Đọc: 4

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
8,566
Được thích
18,145
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

Thành viên hoạt động
Tham gia
27/12/19
Bài viết
109
Được thích
11
Đ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:

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
8,566
Được thích
18,145
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
 

Datcdt2k9

Thành viên hoạt động
Tham gia
27/12/19
Bài viết
109
Được thích
11

File đính kèm

  • Tra ve gia tri tuong ung.xlsm
    9.8 KB · Đọc: 4
Lần chỉnh sửa cuối:

Datcdt2k9

Thành viên hoạt động
Tham gia
27/12/19
Bài viết
109
Được thích
11
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
 

HUONGHCKT

Thành viên tiêu biểu
Tham gia
30/8/12
Bài viết
538
Được thích
735
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

  • Tra ve gia tri tuong ung.xlsm
    20.6 KB · Đọc: 4
Lần chỉnh sửa cuối:

Datcdt2k9

Thành viên hoạt động
Tham gia
27/12/19
Bài viết
109
Được thích
11
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

  • Tra ve gia tri tuong ung (1).xlsm
    19.1 KB · Đọc: 4

HUONGHCKT

Thành viên tiêu biểu
Tham gia
30/8/12
Bài viết
538
Được thích
735
Đú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

  • Tra ve gia tri tuong ung (1).xlsm
    19.1 KB · Đọc: 7

Datcdt2k9

Thành viên hoạt động
Tham gia
27/12/19
Bài viết
109
Được thích
11
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

Thành viên tiêu biểu
Tham gia
30/8/12
Bài viết
538
Được thích
735
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

Thành viên hoạt động
Tham gia
27/12/19
Bài viết
109
Được thích
11
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

  • Tra ve gia tri tuong ung (1).xlsm
    19.2 KB · Đọc: 4

HUONGHCKT

Thành viên tiêu biểu
Tham gia
30/8/12
Bài viết
538
Được thích
735
ý 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.
 

Datcdt2k9

Thành viên hoạt động
Tham gia
27/12/19
Bài viết
109
Được thích
11
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é
 

HUONGHCKT

Thành viên tiêu biểu
Tham gia
30/8/12
Bài viết
538
Được thích
735
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: 7
Web KT
Top Bottom