Thay thế (Replace) mảng dữ liệu theo điều kiện (1 người xem)

[Miccpro]

Chào các anh chị, các anh chị có thể giúp em thay thế các Mã bằng Tên theo điều kiện cho trước như file đính kèm không ạ. Em xin cảm ơn

 

[Phuocam]

Chào các anh chị, các anh chị có thể giúp em thay thế các Mã bằng Tên theo điều kiện cho trước như file đính kèm không ạ. Em xin cảm ơn

Thử

Public Sub ReplaceID()
Dim a, b
Dim i&, j&, lr&, lc&
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
a = Range("L4:M8").Value
b = Range("C4:G8").Value

For i = 1 To UBound(a)
    dic.Item(a(i, 2)) = a(i, 1)
Next
lr = UBound(b, 1)
lc = UBound(b, 2)

For i = 1 To lr
    For j = 1 To lc
    If dic.exists(b(i, j)) Then b(i, j) = dic.Item(b(i, j))
    Next
Next i
    Range("C4").Resize(lr, lc) = b

End Sub

 

[Hoàng Nhật Phương]

Chào các anh chị, các anh chị có thể giúp em thay thế các Mã bằng Tên theo điều kiện cho trước như file đính kèm không ạ. Em xin cảm ơn

Hihi, chậm chân rồi )
Bạn lấy code bài #2 nhé, code bài đó đẳng cấp nhiều so với code bên dưới của OT ạ ^_^

Sub TimKiem_ThayThe()

    Dim Dulieu As Variant, Bangdo As Variant, Ketqua As Variant, sh As Worksheet
    Dim R1 As Long, R2 As Long, I1 As Long, J As Long, I2 As Long
    
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    Dulieu = sh.Range("C4:G" & sh.Range("G10000").End(xlUp).Row): R1 = UBound(Dulieu)
    Bangdo = sh.Range("L4:M" & sh.Range("L10000").End(xlUp).Row): R2 = UBound(Bangdo)
    
    ReDim Ketqua(1 To R1, 1 To 5)
    
    For I1 = 1 To R1
        For J = 1 To 5
            For I2 = 1 To R2
                If Dulieu(I1, J) = Bangdo(I2, 2) Then
                    Ketqua(I1, J) = Bangdo(I2, 1)
                End If
            Next I2
        Next J
    Next I1
    
    sh.Range("C4").Resize(R1, 5).ClearContents
    sh.Range("C4").Resize(R1, 5).Value = Ketqua
    
End Sub

 

[Hoàng Trọng Nghĩa]

Trùi ui, ngắn gọn lẹ, hiệu quả đi các bạn ơi:

Sub ThayThe()
    Dim arrNguon
    Dim sh As Worksheet
    Dim e As Long, r As Long
    Set sh = Sheets("Sheet1")
    e = sh.Range("L" & Rows.Count).End(xlUp).Row
    arrNguon = sh.Range("L4:M" & e).Value
    e = sh.Range("B" & Rows.Count).End(xlUp).Row
    For r = 1 To UBound(arrNguon)
        sh.Range("C4:G" & e).Replace What:=arrNguon(r, 2), Replacement:=arrNguon(r, 1), LookAt:=xlWhole
    Next
End Sub