lọc số tài khoản khách hàng

[nguyenngochaik6tin]

Chào mọi người em đang làm một bài tập về lọc số tài khoản của từng khách hàng ra từng cột khác nhau nhưng mà em làm mãi không ra. mọi người giúp em với. em cảm ơn

 

[mhung12005]

Chào mọi người em đang làm một bài tập về lọc số tài khoản của từng khách hàng ra từng cột khác nhau nhưng mà em làm mãi không ra. mọi người giúp em với. em cảm ơn

Bạn xem file đính kèm nhé.

 

[nguyenngochaik6tin]

anh ơi em hỏi chữ dong trong hàm đấy anh đặt bằng cách nào thế

 

[kimloan96.414]

anh ơi em hỏi chữ dong trong hàm đấy anh đặt bằng cách nào thế

Anh chị mở bảng tính ra bấm Ctr+F3

 

[xuan.nguyen82]

Chào mọi người em đang làm một bài tập về lọc số tài khoản của từng khách hàng ra từng cột khác nhau nhưng mà em làm mãi không ra. mọi người giúp em với. em cảm ơn

Ngồi rảnh làm cái này bằng VBA.
Bạn mở cửa sổ VBA, insert module rồi chép code này vào.
Rồi chỉ cần bấm lệnh cho nó chạy.

Sub Xuan()
Dim sRng(), dRng(), Arr(), I As Long, J As Long, K As Long, Cot As Long
With Sheet1
    .Range(.[A1], .[A65000].End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range( _
        "F1"), Unique:=True
sRng = .Range(.[A2], .[A65000].End(xlUp)).Resize(, 2).Value
dRng = .Range(.[F2], .[F65000].End(xlUp)).Value
ReDim Arr(1 To UBound(dRng, 1), 1 To UBound(sRng, 1))
For I = 1 To UBound(dRng, 1)
    K = 0
    For J = 1 To UBound(sRng, 1)
        If sRng(J, 1) = dRng(I, 1) Then
            K = K + 1
            If Cot < K Then Cot = K
            Arr(I, K) = sRng(J, 2)
        End If
    Next J
Next I
 .[G2].Resize(I - 1, Cot).Value = Arr
End With
End Sub

 

[Ba Tê]

Ngồi rảnh làm cái này bằng VBA.
Bạn mở cửa sổ VBA, insert module rồi chép code này vào.
Rồi chỉ cần bấm lệnh cho nó chạy.

Sub Xuan()
Dim sRng(), dRng(), Arr(), I As Long, J As Long, K As Long, Cot As Long
With Sheet1
    .Range(.[A1], .[A65000].End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range( _
        "F1"), Unique:=True
sRng = .Range(.[A2], .[A65000].End(xlUp)).Resize(, 2).Value
dRng = .Range(.[F2], .[F65000].End(xlUp)).Value
ReDim Arr(1 To UBound(dRng, 1), 1 To UBound(sRng, 1))
For I = 1 To UBound(dRng, 1)
    K = 0
    For J = 1 To UBound(sRng, 1)
        If sRng(J, 1) = dRng(I, 1) Then
            K = K + 1
            If Cot < K Then Cot = K
            Arr(I, K) = sRng(J, 2)
        End If
    Next J
Next I
 .[G2].Resize(I - 1, Cot).Value = Arr
End With
End Sub

Mấy ô G1:I1 là mình nhập thủ công, sao hông "quất" luôn ta?

 

[xuan.nguyen82]

Mấy ô G1:I1 là mình nhập thủ công, sao hông "quất" luôn ta?

Dạ, em định "lười" 1 chút mà bị túm cổ liền à. Hic hic...

 

[nguyenngochaik6tin]

Thank tất cả mọi người nhé

 

[xuan.nguyen82]

Hoàn thiện bài này. Code chạy êm ru.

Sub Xuan()
Dim sRng(), dRng(), Arr(), I As Long, J As Long, K As Long, Cot As Long
With Sheet1
    .Range(.[A1], .[A65000].End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range( _
        "F1"), Unique:=True
sRng = .Range(.[A2], .[A65000].End(xlUp)).Resize(, 2).Value
dRng = .Range(.[F2], .[F65000].End(xlUp)).Value
ReDim Arr(1 To UBound(dRng, 1) + 1, 1 To UBound(sRng, 1))
For I = 1 To UBound(dRng, 1)
    K = 0
    For J = 1 To UBound(sRng, 1)
        If sRng(J, 1) = dRng(I, 1) Then
            K = K + 1: Arr(1, K) = "TK" & K
            If Cot < K Then Cot = K
            Arr(I + 1, K) = sRng(J, 2)
        End If
    Next J
Next I
 .[G1].Resize(I, Cot).Value = Arr
End With
End Sub