Bạn thử tham khảo. .
Dạ, em cảm ơn hai bác đã hỗ trợ ạ.
Tôi sẽ chỉ dùng 1 mảng đầu ra và 1 biến Max:
Không được, item của Dic như bác nói thì phải chứa dữ liệu kép. 1 phần dùng chứa dòng trong mảng đầu ra, một phần chứa colMx. kỹ thuật này rắc rối và chậm hơn dùng mảng phụ.
Đúng là có rắc rối 1 chút nhưng vẫn được như code sau đây. Gắn dict.keys vào mảng kết quả và so sánh.
Sub RowsToCols()
Dim Dict, SArr(), RArr(), TmpArr(), Max As Long, LastRw As Long
Max = 1
Set Dict = CreateObject("Scripting.Dictionary")
With Sheet1
LastRw = .Cells(1000, 1).End(xlUp).Row
SArr = Sheet1.Range("A2:B" & LastRw).Value
End With
ReDim TmpArr(1 To LastRw)
For i = 1 To UBound(SArr, 1)
If Not Dict.Exists(SArr(i, 1)) Then
k = k + 1
Dict.Add SArr(i, 1), 2
TmpArr(k) = k
End If
Next
ReDim RArr(1 To k, 1 To LastRw)
Key1 = Dict.Keys
For j = 1 To k
RArr(j, 1) = Key1(j - 1)
Next
For m = 1 To UBound(SArr, 1)
For n = 1 To k
If SArr(m, 1) = RArr(n, 1) Then
y = Dict.Item(SArr(m, 1))
RArr(n, y) = SArr(m, 2)
If y > Max Then Max = y
Dict.Item(SArr(m, 1)) = Dict.Item(SArr(m, 1)) + 1
End If
Next n
Next m
Sheet2.Range("A2:AZ100").Clear
Sheet2.[A2].Resize(k, Max).Value = RArr
End SubSub ABC()
Dim Dic As Object, a(), b(), i&, n&, Key, k&
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Nguon")
a = .Range("A2:B12").Value
For i = 1 To UBound(a)
Dic(a(i, 1)) = Dic(a(i, 1)) & "|" & a(i, 2)
Next
End With
ReDim b(1 To Dic.Count, 1 To 100)
For Each Key In Dic.keys
s = Split(Dic.Item(Key), "|")
k = k + 1
b(k, 1) = Key
For n = 1 To UBound(s)
b(k, n + 1) = s(n)
Next
If n > Max Then Max = n
Next
Sheets("Ketqua").Range("A7").Resize(Dic.Count, Max).Value = b
End SubCode ngắn hơn, giải pháp hay, nhưng chưa biết việc xử lý chuỗi liên tục kéo dài có bị chậm không nêu như dữ liệu nhiều.
Sub PlayWithArray()
Dim SArr, RArr, Dic1
Dim i As Long, s As Long, EndR As Long, n As Long, Max As Long
't = Timer
Set Dic1 = CreateObject("Scripting.Dictionary")
With Dic1
EndR = Sheet1.[a65000].End(xlUp).Row
SArr = Sheet1.Range("A2:B" & EndR).Value
ReDim RArr(1 To UBound(SArr, 1), 1 To 200)
For i = 1 To UBound(SArr, 1)
If Not .Exists(SArr(i, 1)) Then
s = s + 1
.Add SArr(i, 1), s
RArr(s, 1) = SArr(i, 1)
RArr(s, 2) = SArr(i, 2)
RArr(s, 200) = 2
Else
n = .Item(SArr(i, 1))
RArr(n, 200) = RArr(n, 200) + 1
RArr(n, RArr(n, 200)) = SArr(i, 2)
If RArr(n, 200) > Max Then Max = RArr(n, 200)
End If
Next
End With
Sheet2.[A11].Resize(s, Max) = RArr
End SubTôi khác quan điểm với quý vị ở đây về chuyện "tối ưu" nên tôi trả lời theo ngôn ngữ lập trình.
. Quý vị có trách sao tôi chỉ dám nói vừa thôi thì chớ trách tôi nhé
Năm xưa tôi còn 1 giải pháp là gắn item của Dic bằng mảng, và mỗi mảng sẽ redim preserve tăng lên 1 dần dần để chứa thêm. Nhưng cách đó chậm bằng 4 lần code bài 10 nên tôi bỏ.
Bạn thử cách Query này xem có hơn không ? Mình không biết thử...
let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
Splited = Table.SplitColumn(Table.Group(Source, {"Tên"}, {{"Ma", each Text.Combine([Mã],"+") }}), "Ma", Splitter.SplitTextByDelimiter("+", QuoteStyle.Csv), {"Ma.1", "Ma.2", "Ma.3", "Ma.4", "Ma.5", "Ma.6"})
in
SplitedNgười ta hỏi thẳng là code VBA mờ.
.
Đâu có biết trước tên có nhiều mã nhất là bao nhiêu mã mà xài 6 và đặt 6 cái tên field.
Cái này là học của Anh đó...
Hai bài khác nhau. Bài này muốn xác định số cột phải qua mấy bước trung gian như sau, nhưng chỉ là tính toán nên không làm chậm thêm (nếu chậm thì đã chậm rồi).
let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
Group1 = Table.Group(Source, {"Tên"}, {{"Ma", each Text.Combine([Mã],"+") }}),
Length = Table.AddColumn(Group1,"Len", each Text.Length([Ma]), type number),
MaxLen = Length[Ma]{List.PositionOf(Length[Len], List.Max(Length[Len]))},
ColNum = Text.Length(MaxLen) - Text.Length(Text.Replace(MaxLen, "+","")) + 1,
ColList = Table.AddColumn(Table.FromList({1..ColNum},Splitter.SplitByNothing()),"ColNames", each "Ma" & Text.From([Column1])),
Splitted = Table.SplitColumn(Group1, "Ma", Splitter.SplitTextByDelimiter("+", QuoteStyle.Csv), ColList[ColNames])
in
Splitted
Dữ liệu đã dược sort theo tên, không nên dùng dictionary, chỉ 1 vòng For là xong.
Đúng như Thầy nói. có lẽ viết 1 vòng lặp có lẽ gọn gàng hơn nếu như dữ liệu được sắp xếp trước. Không biết có bị sót lỗi nào có thể xảy ra nữa không?
Sub XYZ()
Dim a(), b(), i&, n&, tam, k&, Max&
With Sheets("Nguon")
a = .Range("A2:B12").Value
ReDim b(1 To UBound(a), 1 To 100)
For i = 1 To UBound(a)
If a(i, 1) <> tam Then
tam = a(i, 1): k = k + 1: n = 1
End If
n = n + 1
b(k, 1) = tam
b(k, n) = a(i, 2)
If n > Max Then Max = n
Next
End With
Sheets("Ketqua").Range("A7").Resize(k, Max).Value = b
End Suba = .Range("A2:B12").Value. Nếu dữ liệu quá dòng 12 thì sao?
