Lọc dữ liệu khách hàng theo mã hàng. (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

huyngo19888

Thành viên mới
Tham gia
2/7/19
Bài viết
10
Được thích
0
Thân gửi các bác,

Em có 1 line dữ liệu gồm mã hàng + khách hàng, rất dài. e cần lọc dữ liệu khách hàng theo cùng 1 mã hàng trong cùng 1 hàng như file đính kèm. Nhờ các bác hướng dẫn em với ạ.

Em cảm ơn.
 

File đính kèm

Thân gửi các bác,

Em có 1 line dữ liệu gồm mã hàng + khách hàng, rất dài. e cần lọc dữ liệu khách hàng theo cùng 1 mã hàng trong cùng 1 hàng như file đính kèm. Nhờ các bác hướng dẫn em với ạ.

Em cảm ơn.
Thử cái code này.
Mã:
Sub abc()
   Dim i As Long, lr As Long, dic As Object, a As Long, b As Long, arr, kq, dk As String
   Set dic = CreateObject("scripting.dictionary")
   With Sheets("sheet1")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A4:B" & lr).Value
        ReDim kq(1 To UBound(arr), 1 To 2)
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            If Not dic.exists(dk) Then
               a = a + 1
               dic.Add dk, a
               kq(a, 1) = arr(i, 1)
               kq(a, 2) = arr(i, 2)
             Else
                b = dic.Item(dk)
                kq(b, 2) = kq(b, 2) & "," & arr(i, 2)
             End If
        Next i
        lr = .Range("F" & Rows.Count).End(xlUp).Row
        If lr > 3 Then .Range("F4:G" & lr).ClearContents
        .Range("F4:G4").Resize(a).Value = kq
   End With
   Set dic = Nothing
End Sub
 
Upvote 0
Thử cái code này.
Mã:
Sub abc()
   Dim i As Long, lr As Long, dic As Object, a As Long, b As Long, arr, kq, dk As String
   Set dic = CreateObject("scripting.dictionary")
   With Sheets("sheet1")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A4:B" & lr).Value
        ReDim kq(1 To UBound(arr), 1 To 2)
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            If Not dic.exists(dk) Then
               a = a + 1
               dic.Add dk, a
               kq(a, 1) = arr(i, 1)
               kq(a, 2) = arr(i, 2)
             Else
                b = dic.Item(dk)
                kq(b, 2) = kq(b, 2) & "," & arr(i, 2)
             End If
        Next i
        lr = .Range("F" & Rows.Count).End(xlUp).Row
        If lr > 3 Then .Range("F4:G" & lr).ClearContents
        .Range("F4:G4").Resize(a).Value = kq
   End With
   Set dic = Nothing
End Sub
bác làm dùm em file excel với. sao e làm run không được ạ. e cảm ơn.
 
Upvote 0
Thân gửi các bác,

Em có 1 line dữ liệu gồm mã hàng + khách hàng, rất dài. e cần lọc dữ liệu khách hàng theo cùng 1 mã hàng trong cùng 1 hàng như file đính kèm. Nhờ các bác hướng dẫn em với ạ.

Em cảm ơn.
Xem file. nhấn nút Lọc để xem và kiểm tra kết quả. Các nội dung khác (định dạng, kẻ khung...) bạn tự làm.
 

File đính kèm

Upvote 0
Xem file. nhấn nút Lọc để xem và kiểm tra kết quả. Các nội dung khác (định dạng, kẻ khung...) bạn tự làm.

Bác giúp e thêm chỗ này với. Ví dụ cột A, B e lỡ nhập trùng nhau, khi lọc kết quả khách hàng nó bỏ trùng đi. thể hiện 1 khách hàng thôi thì làm sao ạ. em cảm ơn.

1656583589841.png
 
Upvote 0

File đính kèm

Upvote 0
Sao không dùng luôn hàm Instr để kiểm tra mà lại phải viết thêm 1 code xóa ký tự vậy.
Cảm ơn anh đã xem bài. Thực tình là tôi không nghĩ ra giải pháp thông minh ấy. nên mày mò (mất tương đối thời gian) để viết lại một hàm để xóa. Giờ anh gợi ý tôi mới chợt nghĩ đến. Hy vọng chủ thớt đọc đến bài #7 của anh sẽ biết cách sửa code theo hướng anh đã gợi ý.
 
Upvote 0
Vẫn còn trùng nè bạn ơi
Cảm ơn bạn đã xem bài.
Tôi nhầm chỗ này.
Mã:
End If
    Res(t,2) = XoaKT(Res(t, 2))
Next i
mà phải là mới đúng
Mã:
End If
    Res(k, 2) = XoaKT(Res(k, 2))
Next i
sửa lại code theo ý anh @snow gợi ý.
Mã:
Option Explicit

Sub Loc()
Dim i&, j&, t&, k&, a&, b&, Lr&, R&
Dim Arr(), Res(), S
Dim Dic As Object, Tmp
Dim Dict As Object

Application.ScreenUpdating = False
With Sheet1
    Lr = .Cells(Rows.Count, 2).End(xlUp).Row
    Arr = .Range("A3:B" & Lr).Value
    R = UBound(Arr)
Set Dic = CreateObject("Scripting.Dictionary")
Set Dict = CreateObject("Scripting.Dictionary")

ReDim Res(1 To R, 1 To 2)
On Error Resume Next
For i = 1 To R
     Tmp = Arr(i, 1)
     If Not Dic.Exists(Tmp) Then
        t = t + 1: Dic.Add (Tmp), t
        Res(t, 1) = Tmp
        Res(t, 2) = Arr(i, 2)
    Else
        k = Dic.Item(Tmp)
        If Len(Res(k, 2)) = 0 Then
            Res(k, 2) = Arr(i, 2)
        Else
            If InStr(1, Res(k, 2), Arr(i, 2)) = 0 Then
                Res(k, 2) = Res(k, 2) & "; " & Arr(i, 2)
            End If
        End If
    End If
  '  Res(k, 2) = XoaKT(Res(k, 2))
Next i
If t Then
    .Range("F3").Resize(1000000, 2).ClearContents
    .Range("F3").Resize(t, 2) = Res
End If

End With
Set Dic = Nothing: Set Dict = Nothing
Application.ScreenUpdating = True
MsgBox "Done", vbInformation, "THÔNG BÁO"
End Sub
lúc này ta không cần hàm XoaKT nữa, có thể xóa bỏ nó trong modul2
 
Lần chỉnh sửa cuối:
Upvote 0
Mã:
Sub Loc()
Dim i&, j&, t&, k&, a&, b&, Lr&, R&
Dim Arr(), Res(), S
Dim Dic As Object, Tmp
Dim Dict As Object
Dùng tới 2 dictionary và 2 array cơ à
Theo mình chỉ dùng 1 cái dict là đủ.
Khi nối chuỗi 1 item mới, dùng intr kiểm tra, nếu chưa có thì ghép vô, không thì thôi.
Sau đó in dict ra sheet thôi.
PHP:
Option Explicit
Sub Loc()
Dim i&, lr&, rng, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
With Sheet1
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A4:B" & lr).Value
    For i = 1 To lr - 3
        If Not dic.Exists(rng(i, 1)) Then
            dic.Add rng(i, 1), rng(i, 2)
        Else
            dic(rng(i, 1)) = dic(rng(i, 1)) & IIf(InStr(1, dic(rng(i, 1)), rng(i, 2)), _
            "", ";" & rng(i, 2))
        End If
    Next
    .Range("F4").Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic.keys)
    .Range("G4").Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic.items)
End With
Set dic = Nothing
End Sub
 

File đính kèm

Upvote 0
Viết một hàm Dax như vầy là giải quyết được bài toán nhé bạn:
Ghép:=CONCATENATEX('Table1','Table1'[Khách hàng]," ,")
1656641134514.png
 

File đính kèm

Upvote 0

File đính kèm

Upvote 0
Theo như yêu cầu của bài #5, vậy hàm này phải lồng distinct vào nữa
À do tôi không đọc những bài bên dưới, nếu bỏ trùng bên danh sách khách hàng thì thêm Distinct hay values đều được:
Ghép#5:=CONCATENATEX(distinct(Table1[Khách hàng]),'Table1'[Khách hàng]," ,")
Ghép#5:=CONCATENATEX(VALUES(Table1[Khách hàng]),'Table1'[Khách hàng]," ,")
 
Upvote 0
Dùng tới 2 dictionary và 2 array cơ à
Theo mình chỉ dùng 1 cái dict là đủ.
Khi nối chuỗi 1 item mới, dùng intr kiểm tra, nếu chưa có thì ghép vô, không thì thôi.
Sau đó in dict ra sheet thôi.
PHP:
Option Explicit
Sub Loc()
Dim i&, lr&, rng, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
With Sheet1
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A4:B" & lr).Value
    For i = 1 To lr - 3
        If Not dic.Exists(rng(i, 1)) Then
            dic.Add rng(i, 1), rng(i, 2)
        Else
            dic(rng(i, 1)) = dic(rng(i, 1)) & IIf(InStr(1, dic(rng(i, 1)), rng(i, 2)), _
            "", ";" & rng(i, 2))
        End If
    Next
    .Range("F4").Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic.keys)
    .Range("G4").Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic.items)
End With
Set dic = Nothing
End Sub
Dict thừa ấy mà. Trong code có dùng đến nó đâu (trường hợp dùng hàm XoaKT thì mói dùng đến nó).
 
Upvote 0
Dùng tới 2 dictionary và 2 array cơ à
Theo mình chỉ dùng 1 cái dict là đủ.
Khi nối chuỗi 1 item mới, dùng intr kiểm tra, nếu chưa có thì ghép vô, không thì thôi.
Sau đó in dict ra sheet thôi.
PHP:
Option Explicit
Sub Loc()
Dim i&, lr&, rng, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
With Sheet1
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A4:B" & lr).Value
    For i = 1 To lr - 3
        If Not dic.Exists(rng(i, 1)) Then
            dic.Add rng(i, 1), rng(i, 2)
        Else
            dic(rng(i, 1)) = dic(rng(i, 1)) & IIf(InStr(1, dic(rng(i, 1)), rng(i, 2)), _
            "", ";" & rng(i, 2))
        End If
    Next
    .Range("F4").Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic.keys)
    .Range("G4").Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic.items)
End With
Set dic = Nothing
End Sub
Rất gọn. Để khi nào vào máy tính xem code hoạt động, học cái chiêu này.
 
Upvote 0
Rất gọn. Để khi nào vào máy tính xem code hoạt động, học cái chiêu này.
Bài này phải đọc hiểu luôn chứ bác hihi. Mấu chốt là cứ add key (mã hàng), với item là khách hàng.
Key chưa có thì cứ add item bình thường, có rồi thì nối item cũ với khách hàng tại dòng đang xét. Nhưng trước khi nối thì xét item đó đã chứa khách hàng đó hay chưa là được (dùng instr).
 
Upvote 0
Đoạn group by, bác gõ lệnh chứ không dùng thao tác ạ,
Nếu dùng thao tác bác có thể hướng dẫn em ko ạ.
Em làm đến đây rồi mà ko làm được tiếp.
View attachment 278330
Tôi dùng thao tác Group By với Sum, sau đó sửa lại thành Text.Combine(List.Distinct(...)))
Toàn bộ đây bạn ạ:
Mã:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Mã hàng ( cố định 9 số )", Int64.Type}, {"Khách hàng ( tổng 12 ký tự - bao gồm số và chữ )", type text}}),
    #"Grouped Rows" = Table.Group(#"Changed Type", {"Mã hàng ( cố định 9 số )"}, {{"Result", each Text.Combine(List.Distinct([#"Khách hàng ( tổng 12 ký tự - bao gồm số và chữ )"]),", ")}})
in
    #"Grouped Rows"
 
Upvote 0
Tôi dùng thao tác Group By với Sum, sau đó sửa lại thành Text.Combine(List.Distinct(...)))
Toàn bộ đây bạn ạ:
Mã:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Mã hàng ( cố định 9 số )", Int64.Type}, {"Khách hàng ( tổng 12 ký tự - bao gồm số và chữ )", type text}}),
    #"Grouped Rows" = Table.Group(#"Changed Type", {"Mã hàng ( cố định 9 số )"}, {{"Result", each Text.Combine(List.Distinct([#"Khách hàng ( tổng 12 ký tự - bao gồm số và chữ )"]),", ")}})
in
    #"Grouped Rows"
Em đoán ở chỗ như bác viết , nhưng làm thao tác add colum mới, gõ cũng không ra
Chắc do em chưa hiểu hết, làm hơi khó.
Em thử làm Sum nó lỗi,

1656918311231.png
 
Upvote 0
Em thử làm Sum nó lỗi,
Chỉ dữ liệu là số mới cộng được chứ nhỉ?
Mã:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Renamed Columns" = Table.RenameColumns(Source,{{"Mã hàng ( cố định 9 số )", "MH"}, {"Khách hàng ( tổng 12 ký tự - bao gồm số và chữ )", "KH"}}),
    #"Grouped Rows" = Table.Group(#"Renamed Columns", {"MH", "KH"}, {{"Count", each "KQ"}}),
    #"Pivoted Column" = Table.Group(#"Grouped Rows", {"MH"}, {{"Count", each Text.Combine(List.Sort([KH]),", "), type text}})
in
    #"Pivoted Column"
 
Upvote 0
Chỉ dữ liệu là số mới cộng được chứ nhỉ?
Mã:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Renamed Columns" = Table.RenameColumns(Source,{{"Mã hàng ( cố định 9 số )", "MH"}, {"Khách hàng ( tổng 12 ký tự - bao gồm số và chữ )", "KH"}}),
    #"Grouped Rows" = Table.Group(#"Renamed Columns", {"MH", "KH"}, {{"Count", each "KQ"}}),
    #"Pivoted Column" = Table.Group(#"Grouped Rows", {"MH"}, {{"Count", each Text.Combine(List.Sort([KH]),", "), type text}})
in
    #"Pivoted Column"
Cũng tính thử Pivot column, nhưng vẫn ko ra đúng ý.
 
Upvote 0
Em đoán ở chỗ như bác viết , nhưng làm thao tác add colum mới, gõ cũng không ra
Chắc do em chưa hiểu hết, làm hơi khó.
Em thử làm Sum nó lỗi,

View attachment 278332
Lỗi là do cột Khách Hàng không phải định dạng number, mục đích bài này là nối chuỗi và loại trùng,
Bạn thay List.Sum bằng {{"Count",each Text.Combine(List.Distinct([cột KH]),"|")}, type text}) là được.
 
Lần chỉnh sửa cuối:
Upvote 0
Em đoán ở chỗ như bác viết , nhưng làm thao tác add colum mới, gõ cũng không ra
Chắc do em chưa hiểu hết, làm hơi khó.
Em thử làm Sum nó lỗi,

View attachment 278332
Do dữ liệu là Text nên đương nhiên Sum sẽ ra lỗi.
Bạn sửa chữ List.Sum đó thành Text.Combine(List.Distinct(...), ", ") là ra kết quả ngay đó.
 
Upvote 0
Do dữ liệu là Text nên đương nhiên Sum sẽ ra lỗi.
Bạn sửa chữ List.Sum đó thành Text.Combine(List.Distinct(...), ", ") là ra kết quả ngay đó.
Sửa công thức từ List... lồng thêm Text.combine kia em thấy khá nhiều hướng dẫn, nhưng lâu không dùng nên hơi khó nhớ,
làm 1 hồi thì cũng ra được thao tác làm đến đây,
:))))))))
1656993286659.png
 
Upvote 0
Sửa công thức từ List... lồng thêm Text.combine kia em thấy khá nhiều hướng dẫn, nhưng lâu không dùng nên hơi khó nhớ,
làm 1 hồi thì cũng ra được thao tác làm đến đây,
:))))))))
View attachment 278361
Chịu khó sẽ có kết quả.
Sai rồi mới đến lúc đúng vì không làm chắc chắn không bao giờ đúng.
 
Upvote 0
Mình cần lấy dữ liệu ntn, nhờ ae giúp đỡ, cảm ơn
1657156281871.png
 

File đính kèm

Upvote 0
Mình cần lấy dữ liệu ntn, nhờ ae giúp đỡ, cảm ơn
View attachment 278465


Yêu cầu này dùng Power Query xử lý được.
1. Split cột ra rồi unpivot
2. Loại bỏ các cặp trùng nhau (đơn giản nhất cứ nối lại và remove duplicate)

Sau đó được kết quả như hình dưới.
Bước tiếp theo thì không khác gì các bài trên.
 

File đính kèm

  • 111.png
    111.png
    27.6 KB · Đọc: 18
Upvote 0
Mình cần lấy dữ liệu ntn, nhờ ae giúp đỡ, cảm ơn
View attachment 278465
Bạn dùng M code này
Mã:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(Source, {{"Col2", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Col2"),
    #"Trimmed Text" = Table.TransformColumns(#"Split Column by Delimiter",{{"Col2", Text.Trim, type text}}),
    #"Grouped Rows" = Table.Group(#"Trimmed Text", {"Col2"}, {{"KQ", each Text.Combine(List.Distinct([Col1]),", "), type text}})
in
    #"Grouped Rows"
1657159209675.png
 
Upvote 0
Công thức trên MS365 bạn nhé:

E10=UNIQUE(FILTERXML("<p><c>"&SUBSTITUTE(TEXTJOIN(", ",,C3:C9),", ","</c><c>")&"</c></p>","//c"))
F10=TEXTJOIN(", ",1,IF(ISNUMBER(FIND(E10,$C$3:$C$9)),$B$3:$B$9,"")) kéo xuống.
 

File đính kèm

  • 1657159701103.png
    1657159701103.png
    195.4 KB · Đọc: 13
  • 1657159729280.png
    1657159729280.png
    188.4 KB · Đọc: 16
Upvote 0
Bạn dùng M code này
Mã:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(Source, {{"Col2", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Col2"),
    #"Trimmed Text" = Table.TransformColumns(#"Split Column by Delimiter",{{"Col2", Text.Trim, type text}}),
    #"Grouped Rows" = Table.Group(#"Trimmed Text", {"Col2"}, {{"KQ", each Text.Combine(List.Distinct([Col1]),", "), type text}})
in
    #"Grouped Rows"
View attachment 278472
Mình dùng code này mà ko đc, bạn có thể cho mình xin file đã làm đc ko, cảm ơn nhiều
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom