mhung12005
Thành viên chậm chạm
- Tham gia
- 20/7/11
- Bài viết
- 1,598
- Được thích
- 1,261
- Nghề nghiệp
- Đâu có việc thì làm
Dhn46 nghĩ bạn có thể làm theo các hướng sau:
* Hướng 1:
- B1: Sắp xếp theo ngày
- B2: Cho vòng lặp chạy từ 1 =>n
- B3: Tiến hành so sánh phần tử i và i+1, nếu i = i+1 thì sẽ thêm dữ liệu mảng theo chiều ngang, nếu không thì tiếp tục thêm hàng để chạy các phần tử khác
=> Cứ thế cho đến hết
*Hướng 2: Sử dụng Dictionary
- B1: Cho vòng lặp chạy từ 1 =>n
- B2: Add ngày vào Dic, nếu chưa tồn tại Key thì thêm hàng, tồn tại thì thêm dữ liệu theo chiều ngang
=> Tiến hành cho đến hết dữ liệu
Vấn đề xác định vị trí thêm dữ liệu của các hàng bạn có thể dùng Array phụ để ghi nhớ, hoặc dùng vòng lặp kiểm tra, hoặc gán vào vị trí cuối cùng của mảng rồi truy xuất.
Hy vọng giúp bạn hình dung được.
Bạn có thể tham khảo 1 cách theo topic sau:http://www.giaiphapexcel.com/forum/...ng-ngày-theo-từng-đơn-giá&p=530412#post530412
Chúc bạn thành công!
Vấn đề xác định vị trí thêm dữ liệu của các hàng bạn có thể dùng Array phụ để ghi nhớ, hoặc dùng vòng lặp kiểm tra, hoặc gán vào vị trí cuối cùng của mảng rồi truy xuất.
Vâng dhn46 cũng "đoán" bạn đang mắc tại vị trí trên nên đã ghi phần chú ý ra 1 khoảng riêng.Cảm ơn dhn46.
Thực ra tôi cũng đang làm bài ở topic đó và đang đi theo hướng 2 như bạn nói. Nhưng đến đoạn này thì mắc:
....................................
dhn46 có thể gợi ý thêm chút nữa không ?
Cảm ơn bạn.
Sub Tonghop()
Dim i As Long, k As Long, j As Long
Dim Arr, sArr, IndexArr
Arr = Sheet2.Range("A6:D" & Sheet2.Range("A65536").End(3).Row)
ReDim sArr(1 To UBound(Arr, 1), 1 To 200)
ReDim IndexArr(1 To UBound(Arr, 1))
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr, 1)
If Not .Exists(Arr(i, 1)) Then
k = k + 1
.Add Arr(i, 1), k
For j = 1 To 4
sArr(k, j) = Arr(i, j)
Next
IndexArr(k) = 4
Else
For j = 1 To 3
sArr(.Item(Arr(i, 1)), IndexArr(.Item(Arr(i, 1))) + j) = Arr(i, j + 1)
Next
IndexArr(.Item(Arr(i, 1))) = IndexArr(.Item(Arr(i, 1))) + 3
End If
Next
End With
Sheet2.Range("G6").Resize(k, 200) = sArr
End Sub
Sub ChangeArr()
Dim i As Long, x As Long
Dim j As Long, m As Long
Dim k As Long
Dim DIC As Object
Dim sArr(), dArr()
Set DIC = CreateObject("scripting.dictionary")
sArr = Sheet2.Range("A6:D" & Sheet2.[D65536].End(xlUp).Row).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To UBound(sArr, 1) * UBound(sArr, 2))
For i = 1 To UBound(sArr, 1)
If Not DIC.Exists(sArr(i, 1)) Then
m = UBound(sArr, 2)
k = k + 1
DIC.Add sArr(i, 1), k
For x = 1 To UBound(sArr, 2)
dArr(k, x) = sArr(i, x)
Next x
Else:
j = DIC.Item(sArr(i, 1))
For x = 2 To UBound(sArr, 2)
m = m + 1
dArr(j, m) = sArr(i, x)
Next x
End If
Next i
If k Then Sheet2.[G6].Resize(k, UBound(sArr, 1) * UBound(sArr, 2)) = dArr
End Sub
Hoacoi ơi hình như chưa ổn lắm, bạn thử copy dữ liệu trên xuống 2,3 lần rồi chạy Code xem sẽ có những khoảng dữ liệu trống.Em không dùng Array phụ như dhn46 thì ghi nhớ vị trí thế này anh ạ :
...............................
Hehe, chưa nghĩ tới tình huống này vì cứ nhằm dữ liệu của anh mhung12005 mà viết thui, có thể khắc phục bằng cách thêm 1 dòng code sort trước khi gán vào sArr(), cách này có thể làm thay đổi cấu trúc dữ liệu nhưng cũng có thể copy qua chỗ khác sort rùi chạy code, cháy rùi nên phải chữa thui, hiiiiiiiiiiiiiHoacoi ơi hình như chưa ổn lắm, bạn thử copy dữ liệu trên xuống 2,3 lần rồi chạy Code xem sẽ có những khoảng dữ liệu trống.
Code của bạn cũng không cần phải Sort (Nếu Sort sẽ không tận dụng linh hoạt của Dic) chỉ cần bắt lỗi 1 chút, mình sửa lại từ chỗ Else:Hehe, chưa nghĩ tới tình huống này vì cứ nhằm dữ liệu của anh mhung12005 mà viết thui, có thể khắc phục bằng cách thêm 1 dòng code sort trước khi gán vào sArr(), cách này có thể làm thay đổi cấu trúc dữ liệu nhưng cũng có thể copy qua chỗ khác sort rùi chạy code, cháy rùi nên phải chữa thui, hiiiiiiiiiiiii
Else:
j = DIC.Item(sArr(i, 1))
For col = 1 To UBound(dArr, 2)
If dArr(j, col) = "" Then
For x = 2 To UBound(sArr, 2)
col = col + 1
dArr(j, col - 1) = sArr(i, x)
Next x
Exit For
End If
Next
End If
Next i
If k Then Sheet2.[G6].Resize(k, UBound(sArr, 1) * UBound(sArr, 2)) = dArr
End Sub
Chuyện này khó xảy ra:Hoacoi ơi hình như chưa ổn lắm, bạn thử copy dữ liệu trên xuống 2,3 lần rồi chạy Code xem sẽ có những khoảng dữ liệu trống.
Gửi chú MỹChuyện này khó xảy ra:
1. Giả sử Ngày tháng theo thứ tự tăng dần, nếu copy dữ liệu xuống, té ra ngày lập lại, code chạy không đúng là đương nhiên
2. Giả sử ngày không theo thứ tự tăng dần, nghĩa là ngày có thể lập lại phía dưới, nhưng giá sẽ không lập lại. Vì đây là bảng liệt kê những giá khác nhau trong từng ngày. Nếu giá không lập lại thì nó tiếp tục tràn qua bên phải là đúng.
3. Giả sử ngày tháng không theo thứ tự, và giá cũng có lập lại, thì code sai, nhưng đây là sai do tác giả cho dữ liệu mẫu quá ít. V2 khi trong cùng ngày mà cùng giá, có lẽ phải cộng lại cho kết quả bảng 2, chứ không phải liệt kê tất tần tật.
Cảm ơn thầy về cách phân tích logic dữ liệu thực tế nhưng trò cũng không phản đối câu hỏi mà dhn46 đặt lại cho trò vì đến đây thì không dừng lại ở yêu cầu giải quyết bài toán nữa mà muốn ôn lại Dictionary thôi thầy ạ! Cũng có nhiều người thấy khó chịu khi mở rộng chủ đề ra như thế này vì dữ liệu có sao thì làm vậy, rùi lỗi đâu sửa đó còn trò thì lại không nghĩ thế, lên diễn đàn để học hỏi mà! heheChuyện này khó xảy ra:
1. Giả sử Ngày tháng theo thứ tự tăng dần, nếu copy dữ liệu xuống, té ra ngày lập lại, code chạy không đúng là đương nhiên
2. Giả sử ngày không theo thứ tự tăng dần, nghĩa là ngày có thể lập lại phía dưới, nhưng giá sẽ không lập lại. Vì đây là bảng liệt kê những giá khác nhau trong từng ngày. Nếu giá không lập lại thì nó tiếp tục tràn qua bên phải là đúng.
3. Giả sử ngày tháng không theo thứ tự, và giá cũng có lập lại, thì code sai, nhưng đây là sai do tác giả cho dữ liệu mẫu quá ít. V2 khi trong cùng ngày mà cùng giá, có lẽ phải cộng lại cho kết quả bảng 2, chứ không phải liệt kê tất tần tật.
Gửi chú Mỹ
2/ Nếu dữ liệu tràn ra thì tràn không có khoảng trống chứ chú, tức là tràn ra 1 khoảng liên tục
3/ Trường hợp này là trường hợp hy hữu chứ chưa chắc đã không, bởi nếu họ cầm 1 cuốn sổ ghi chép rồi nhập thì khả năng nhập nhầm 1 dòng, đảo lộn 1 dòng là có thể xảy ra, đó là chưa kể người ghi chép quên ngày 1 lên xuống bao nhiêu để rồi chèn vào ngày 2 một khoảng của ngày 1 => lúc nhập vào máy sẽ xảy ra trường hợp trên.
Đây là cháu thiên nhiều về thuật toán hơn là việc xét đúng sai của của CODE.
Vâng dhn46 cũng "đoán" bạn đang mắc tại vị trí trên nên đã ghi phần chú ý ra 1 khoảng riêng.
Việc định vị trí này bạn thử tham khảo đoạn Code sau nhé,
Mã:Sub Tonghop() Dim i As Long, k As Long, j As Long Dim Arr, sArr, IndexArr Arr = Sheet2.Range("A6:D" & Sheet2.Range("A65536").End(3).Row) ReDim sArr(1 To UBound(Arr, 1), 1 To 200) ReDim IndexArr(1 To UBound(Arr, 1)) With CreateObject("Scripting.Dictionary") For i = 1 To UBound(Arr, 1) If Not .Exists(Arr(i, 1)) Then k = k + 1 .Add Arr(i, 1), k For j = 1 To 4 sArr(k, j) = Arr(i, j) Next IndexArr(k) = 4 Else For j = 1 To 3 sArr(.Item(Arr(i, 1)), IndexArr(.Item(Arr(i, 1))) + j) = Arr(i, j + 1) Next IndexArr(.Item(Arr(i, 1))) = IndexArr(.Item(Arr(i, 1))) + 3 End If Next End With Sheet2.Range("G6").Resize(k, 200) = sArr End Sub
Sub MakeTable()
Dim DataRg, i, Arr(1 To 10000, 1 To 255), Tm(), SaveDate As String
Dim MaxR, MaxC, Pos
DataRg = Sheet1.Range("A6:D" & Sheet1.[A65536].End(3).Row)
For i = 1 To UBound(DataRg, 1)
If InStr(1, SaveDate, CLng(DataRg(i, 1))) = 0 Then
SaveDate = SaveDate & CLng(DataRg(i, 1))
MaxR = MaxR + 1
ReDim Preserve Tm(1 To MaxR)
Arr(MaxR, 1) = DataRg(i, 1)
Arr(MaxR, 2) = DataRg(i, 2)
Arr(MaxR, 3) = DataRg(i, 3)
Arr(MaxR, 4) = DataRg(i, 4)
Tm(MaxR) = 4
If MaxC < 4 Then MaxC = 4
Else
Pos = Int(InStr(1, SaveDate, CLng(DataRg(i, 1))) / 5) + 1
Arr(Pos, Tm(Pos) + 1) = DataRg(i, 2)
Arr(Pos, Tm(Pos) + 2) = DataRg(i, 3)
Arr(Pos, Tm(Pos) + 3) = DataRg(i, 4)
Tm(Pos) = Tm(Pos) + 3
If MaxC < Tm(Pos) Then MaxC = Tm(Pos)
End If
Next
Sheet1.[G6].Resize(MaxR, MaxC) = Arr
End Sub
Sub test()
Dim Arr(), arrKQ(), i, j, k, r, c
With ThisWorkbook.Sheets("sheet2")
Arr = .Range(.[A5], .[A65536].End(xlUp)).Resize(, 4).Value
For i = UBound(Arr, 1) To 2 Step -1
If Arr(i, 1) = Arr(i - 1, 1) Then
Arr(i, 1) = ""
k = k + 1
Else
r = r + 1
k = 0
End If
If k > j Then j = k
Next
ReDim arrKQ(1 To r + 1, 1 To 3 * j + 4)
k = 0: j = 0
For i = 1 To UBound(Arr, 1)
If Arr(i, 1) <> "" Then
k = k + 1
arrKQ(k, 1) = Arr(i, 1)
arrKQ(k, 2) = Arr(i, 2)
arrKQ(k, 3) = Arr(i, 3)
arrKQ(k, 4) = Arr(i, 4)
j = 0
Else
j = j + 1
arrKQ(1, 3 * j + 2) = Left(Arr(1, 2), 4) & j + 1
arrKQ(1, 3 * j + 3) = Arr(1, 3)
arrKQ(1, 3 * j + 4) = Arr(1, 4)
arrKQ(k, 3 * j + 2) = Arr(i, 2)
arrKQ(k, 3 * j + 3) = Arr(i, 3)
arrKQ(k, 3 * j + 4) = Arr(i, 4)
End If
Next
.Range("g20").Resize(UBound(arrKQ, 1), UBound(arrKQ, 2)) = arrKQ
End With
End
End Sub
Vâng dhn46 cũng "đoán" bạn đang mắc tại vị trí trên nên đã ghi phần chú ý ra 1 khoảng riêng.
Việc định vị trí này bạn thử tham khảo đoạn Code sau nhé,
Em không dùng Array phụ như dhn46 thì ghi nhớ vị trí thế này anh ạ :
Chuyện này khó xảy ra:
1. Giả sử Ngày tháng theo thứ tự tăng dần, nếu copy dữ liệu xuống, té ra ngày lập lại, code chạy không đúng là đương nhiên
2. Giả sử ngày không theo thứ tự tăng dần, nghĩa là ngày có thể lập lại phía dưới, nhưng giá sẽ không lập lại. Vì đây là bảng liệt kê những giá khác nhau trong từng ngày. Nếu giá không lập lại thì nó tiếp tục tràn qua bên phải là đúng.
3. Giả sử ngày tháng không theo thứ tự, và giá cũng có lập lại, thì code sai, nhưng đây là sai do tác giả cho dữ liệu mẫu quá ít. V2 khi trong cùng ngày mà cùng giá, có lẽ phải cộng lại cho kết quả bảng 2, chứ không phải liệt kê tất tần tật.
Theo tôi, bản thân bảng 2 không có ý nghĩa về mặt báo cáo.
Tôi nghĩ 1 báo cáo theo kiểu ngang của bảng 2, cần liệt kê tất cả các mức giá theo hàng ngang, ngày nào có mức giá nào thì thống kê ở cột đó. Ý nghĩa của báo cáo là phân loại doanh thu theo giá. Cộng theo cột sẽ là tổng doanh thu theo từng giá khác nhau. Và như vậy sẽ làm bằng pivot table, khỏi code
Như bảng 2 hiện giờ chỉ có nghĩa thống kê 1 ngày có bao nhiêu giá, không cần biết giá bao nhiêu. Cộng theo cột thì không có ý nghĩa gì.
Mục 3: dhn chưa hiểu ý chú, ý chú là nếu giá bị trùng trong 1 ngày, lẽ ra tác giả phải yêu cầu cộng các dòng có giá giống nhau lại, thay vì liệt kê nhiều lần riêng rẽ.
Sao cần array phụ chi, bạn có thể lưu thông tin đó vào Dic lun mà,
Và sArray có thể dùng REDIM
Mình tham gia 1 cách không dùng Dic (Xin lỗi kiểu du kích không dám gọi là giải thuật gì cả) nhưng với thực tế thì áp dụng cũng tốt mà tốc độ dám cá với Dic đấy.