huyngo19888
Thành viên mới

- Tham gia
- 2/7/19
- Bài viết
- 10
- Được thích
- 0
Thử cái code này.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.
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.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
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.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.
Của bạn đây.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.
View attachment 278140
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 ý.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ủa bạn đây.
Xem file đính kèm
Cảm ơn bạn đã xem bài.Vẫn còn trùng nè bạn ơi
End If
Res(t,2) = XoaKT(Res(t, 2))
Next i
End If
Res(k, 2) = XoaKT(Res(k, 2))
Next i
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
Dùng tới 2 dictionary và 2 array cơ à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
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
Code phức tạp thì bạn có thể tìm hiểu dùng Power Query.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.
View attachment 278140
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ữaViế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]," ,")
À 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: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
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ó).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.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
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.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.
Tôi dùng thao tác Group By với Sum, sau đó sửa lại thành Text.Combine(List.Distinct(...)))Đ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
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 raTô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"
Chỉ dữ liệu là số mới cộng được chứ nhỉ?Em thử làm Sum nó lỗi,
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 ý.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"
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,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
Bác có biết thao tác không ạ,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(Distinct([cột KH]),"|")}, type text}) là được.
Do dữ liệu là Text nên đương nhiên Sum sẽ ra lỗi.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
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ớ,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 đó.
Chịu khó sẽ có kết quả.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
Cái của mình lúc đầu là sài 2 cái Group, sau đó thử dùng pivot thì cũng được nhưng nó lủng củng lên quay lại phương án sài 2group, xong quên xoá tên cái "Pivot column"Cũng tính thử Pivot column
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àyMình cần lấy dữ liệu ntn, nhờ ae giúp đỡ, cảm ơn
View attachment 278465
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"
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ềuBạn dùng M code này
View attachment 278472Mã: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"
Gửi bạn file, bạn không nên viết tắt.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
Cảm ơn bạn, sao mình thay đổi dữ liệu và chạy lại macro mà dữ liệu nó ko thay đổi theo nhỉGửi bạn file, bạn không nên viết tắt.
Bạn gửi file đó lên đây.Cảm ơn bạn, sao mình thay đổi dữ liệu và chạy lại macro mà dữ liệu nó ko thay đổi theo nhỉ