Sắp xếp 2 cột tương ứng với nhau

[baothang4292]

Em có dữ liệu 2 cột, nhưng nó có cái giống có cái khác nhau, làm sao để sắp xếp tương ứng những cái giống nhau chung 1 dòng được ạ?

 

[phulien1902]

Em có dữ liệu 2 cột, nhưng nó có cái giống có cái khác nhau, làm sao để sắp xếp tương ứng những cái giống nhau chung 1 dòng được ạ?

Bạn thử:

Sub abc()
    Dim i&, j&, LR&
    j = 1
    LR = Range("A" & Rows.Count).End(3).Row
    With Range("C1:C" & LR)
        .Formula = "=SUM(COUNTIF(R1C2:R18C2,RC[-2]&""*""))"
        .Value = .Value
    End With
    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        Cells(j, 11).Resize(Cells(i, 3)).Value = Cells(i, 1)
        j = j + Cells(i, 3)
    Next
    For i = 1 To Cells(Rows.Count, 11).End(3).Row
        If Application.CountIf(Range("k1:k" & i), Cells(i, 11)) > 1 Then Cells(i, 11).ClearContents
        Cells(i, 12).Value = Cells(i, 2).Value
    Next
    Range("C1:C" & LR).ClearContents
End Sub

 

[Ba Tê]

Em có dữ liệu 2 cột, nhưng nó có cái giống có cái khác nhau, làm sao để sắp xếp tương ứng những cái giống nhau chung 1 dòng được ạ?

Dùng mảng trong VBA:

Public Sub GPE()
Dim Arr1(), Arr2(), Tem As String
Dim I As Long, J As Long, K As Long, N As Long, R1 As Long, R2 As Long
Arr1 = Range("A1", Range("A1").End(xlDown)).Value
Arr2 = Range("B1", Range("B1").End(xlDown)).Value
R1 = UBound(Arr1):      R2 = UBound(Arr2)
ReDim dArr(1 To R2, 1 To 2)
For I = 1 To R1
    Tem = Arr1(I, 1)
    N = Len(Tem):       K = K + 1
    dArr(K, 1) = Tem:   K = K - 1
    For J = 1 To R2
        If Arr2(J, 1) <> Empty Then
            If Left(Arr2(J, 1), N) = Tem Then
                K = K + 1
                dArr(K, 2) = Arr2(J, 1)
                Arr2(J, 1) = Empty
            End If
        End If
    Next J
Next I
Range("D1").Resize(K, 2) = dArr
End Sub

 

[baothang4292]

cảm ơn
phulien1902 với Ba Tê, để em thử xem sao ạ ^^