Biên tập lại dữ liệu bằng VBA

[hiennd86]

Chào mọi người, mình có một file excel gồm sheet1 và sheet2 có cấu trúc gồm cột A, B, C tương ứng là STT, Mã, Người nhận. Bây giờ mình muốn biên tập lại dữ liệu trong sheet 1 về dạng như trong sheet 2. Giả sử như (06)Sâu róm thì mình muốn biên tập lại thành CTV006. (2)thuy huong sẽ thành CTV002, (72) hue mai sẽ thành CTV072. (508)Minh trang trong cột C tương ứng với 3 giá trị trong cột B thì sẽ nhóm 3 giá trị trong cột B lại. Mong mọi người giúp đỡ mình với. Chân thành cảm ơn mọi người!

 

[HUONGHCKT]

Chào mọi người, mình có một file excel gồm sheet1 và sheet2 có cấu trúc gồm cột A, B, C tương ứng là STT, Mã, Người nhận. Bây giờ mình muốn biên tập lại dữ liệu trong sheet 1 về dạng như trong sheet 2. Giả sử như (06)Sâu róm thì mình muốn biên tập lại thành CTV006. (2)thuy huong sẽ thành CTV002, (72) hue mai sẽ thành CTV072. (508)Minh trang trong cột C tương ứng với 3 giá trị trong cột B thì sẽ nhóm 3 giá trị trong cột B lại. Mong mọi người giúp đỡ mình với. Chân thành cảm ơn mọi người!

Dùng tạm code này trong khi chờ các giải pháp khác.

Option Explicit

Sub ABC()
Dim i&, Lr&, t&, k&, n&
Dim Ws As Worksheet, Sh As Worksheet
Dim Dic As Object
Dim Temp, Tmp, Key
Set Sh = Sheet2
Set Ws = Sheet1
Set Dic = CreateObject("Scripting.Dictionary")
Lr = Ws.Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To Lr
    Temp = Right(Sh.Cells(i, 3), 3)
    If Not Dic.Exists(Temp) Then Dic.Add (Temp), i
Next i
For i = 2 To Lr
    Tmp = Ws.Cells(i, 3)
    n = InStr(1, Tmp, ")") - 2
    Key = Format(Mid(Tmp, 2, n), "00#")
    If Dic.Exists(Key) Then
        Ws.Cells(i, 4) = Sh.Cells(Dic.Item(Key), 3)
    Else
        Ws.Cells(i, 4) = "Không có"
End If
Next i
Set Dic = Nothing
MsgBox "Thành công"
End Sub

Hãy nhấn nút "Run code" trên sheet1 để xem kết quả từ D2

 

[Phuocam]

Hoặc thử code này:

Sub Test()
Dim i&, Lr&, t&, k&, Temp$
Dim Sarr, Rarr
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
    Lr = .Cells(Rows.Count, 2).End(xlUp).Row
    Sarr = .Range("A2:C" & Lr).Value
End With
ReDim Rarr(1 To Lr, 1 To 3)
For i = 1 To UBound(Sarr, 1)
    Temp = Sarr(i, 3)
    If Not Dic.Exists(Temp) Then
        k = k + 1
        Dic.Add (Temp), k
        Rarr(k, 1) = k
        Rarr(k, 2) = Sarr(i, 2)
        Rarr(k, 3) = "CTV" & Format(Mid(Split(Temp, ")")(0), 2), "000")
    Else
        t = Dic.Item(Temp)
        Rarr(t, 2) = Rarr(t, 2) & ", " & Sarr(i, 2)
    End If
Next i
With Sheets("Sheet2")
    .UsedRange.Offset(1).ClearContents
    If k > 0 Then .Range("A2").Resize(k, 3).Value = Rarr
End With
End Sub

 

[SA_DQ]

Kết quả còn đang sai, cần chỉnh lại
Xin các bạn thứ lỗi!

 

[hiennd86]

Dùng tạm code này trong khi chờ các giải pháp khác.

Option Explicit

Sub ABC()
Dim i&, Lr&, t&, k&, n&
Dim Ws As Worksheet, Sh As Worksheet
Dim Dic As Object
Dim Temp, Tmp, Key
Set Sh = Sheet2
Set Ws = Sheet1
Set Dic = CreateObject("Scripting.Dictionary")
Lr = Ws.Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To Lr
    Temp = Right(Sh.Cells(i, 3), 3)
    If Not Dic.Exists(Temp) Then Dic.Add (Temp), i
Next i
For i = 2 To Lr
    Tmp = Ws.Cells(i, 3)
    n = InStr(1, Tmp, ")") - 2
    Key = Format(Mid(Tmp, 2, n), "00#")
    If Dic.Exists(Key) Then
        Ws.Cells(i, 4) = Sh.Cells(Dic.Item(Key), 3)
    Else
        Ws.Cells(i, 4) = "Không có"
End If
Next i
Set Dic = Nothing
MsgBox "Thành công"
End Sub

Hãy nhấn nút "Run code" trên sheet1 để xem kết quả từ D

Cảm ơn bạn nhé, nhưng khi mình cop dữ liệu mới vào thì kết quả có dòng ra đúng có dòng ra sai bạn ạ

 

[Hoàng Tuấn 868]

Cảm ơn bạn nhé, nhưng khi mình cop dữ liệu mới vào thì kết quả có dòng ra đúng có dòng ra sai bạn ạ

Cái khó của người giúp là làm thế nào đoán được chỗ sai mà người được giúp tuy phát hiện ra, nhưng không chỉ cụ thể sai dòng nào mà chỉ nói: "có dòng ra sai".

 

[SA_DQ]

. . . . mà chỉ nói: "có dòng ra sai".

Có khi (,Có khi" à nha) đó là 1 mánh lới trong công cuộc học từ hỏi!

 

[HUONGHCKT]

Cảm ơn bạn nhé, nhưng khi mình cop dữ liệu mới vào thì kết quả có dòng ra đúng có dòng ra sai bạn ạ

Dữ liệu mới thê nào? sau khi chạy code nó sai ở dòng nào? thê nào mới là đúng?
Bạn có thể chụp màn hình trước và sau chạy code và đăng lên cho mọi người cùng xem được không?Biết đâu đó lại có thêm giải pháp nữa tối ưu hơn.