dò tìm mã đơn hàng và mã hàng duy nhất
- Thread starter BinhTam
- Ngày gửi
hoangminhtien
Thành viên gắn bó
- Tham gia
- 29/2/08
- Bài viết
- 1,685
- Được thích
- 2,226
- Nghề nghiệp
- Mechanical Engineering
Bạn xem trong file có đúng ý bạn không nhé!
boyxin
Members actively
- Tham gia
- 10/3/08
- Bài viết
- 1,664
- Được thích
- 2,335
Nhấn nút [Source] & [Item] và kiểm tra lại kết quả nhé
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,952
Bài này dùng Dictionary Object là "bá chấy" luôn ---> Khỏi cột phụ hay name gì cả ---> Bảo đảm tốc độ nhanh
Các bạn thử xem
Các bạn thử xem
Loại file này mà làm công thức thì hơi mệt đây, cả boyxin và hoangminhtien đều chưa làm hết yếu cầu, còn lấy dữ liệu vào cột A, B, C nữa. Riêng Boyxin mới chỉ lấy duy nhất theo source mà chưa cộng.
Cách theo NDU chỉ dùng CreateObject("Scripting.Dictionary") kết hợp với UDF TachSo cũng của NDU luôn, hy vọng sẽ nhanh hơn.
Tôi sẽ làm thử 1 code theo hướng của NDU, nhân tiện học hỏi.
Tôi viết thử code sau, và hình như sẽ có code không cần Dic nếu cột Source đã sort.
Các bạn xem thử.
PHP:
Dim endR As Long
Dim Arr(), ArrKQ(1 To 65000, 1 To 5), ArrXX(1 To 65000, 1 To 1)
Dim Dic As Object
Dim i As Long, s As Long, Src As String
Dim T
Sub TaoSource()
T = Timer
ThisWorkbook.Activate
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("T7-2010")
endR = .Cells(65000, 1).End(xlUp).Row
Arr = .Range(.Cells(2, 1), .Cells(endR, 7)).Value
End With
s = 0
For i = 1 To UBound(Arr)
'Src = TachSo(Arr(i, 4))
If Not Dic.Exists(Arr(i, 4)) Then
s = s + 1
ArrKQ(s, 1) = s
ArrKQ(s, 2) = Arr(i, 1)
ArrKQ(s, 3) = Arr(i, 3)
ArrKQ(s, 4) = TachSo(Arr(i, 4))
Dic.Add Arr(i, 4), s
End If
ArrKQ(s, 5) = ArrKQ(s, 5) + Arr(i, 6)
Next i
With Sheets("Summary")
With .Range("M3")
.Resize(s, 5) = ArrKQ
End With
End With
Set Dic = Nothing
Erase Arr, ArrKQ
MsgBox Timer - T
End SubCám ơn!
Bổ sung, trường hợp lấy số này nên dùng replece sẽ nhanh hơn UDF. Và mình sẽ lấy toàn bộ thông tin source, sau đó tách lấy số sau thì sẽ nhanh hơn.
Code tham khảo
PHP:
Sub TaoSource3()
Dim endR As Long
Dim Arr(), ArrKQ(1 To 65000, 1 To 5), ArrXX(1 To 65000, 1 To 1)
Dim Dic As Object
Dim i As Long, s As Long, Src As String
Dim T
T = Timer
Dim arrTach(1 To 65000, 1 To 1)
ThisWorkbook.Activate
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("T7-2010")
endR = .Cells(65000, 1).End(xlUp).Row
Arr = .Range(.Cells(2, 1), .Cells(endR, 7)).Value
End With
s = 0
For i = 1 To UBound(Arr)
If Not Dic.Exists(Arr(i, 4)) Then
s = s + 1
ArrKQ(s, 1) = s
ArrKQ(s, 2) = Arr(i, 1)
ArrKQ(s, 3) = Arr(i, 3)
ArrKQ(s, 4) = Arr(i, 4)
arrTach(s, 1) = ArrKQ(s, 4)
Dic.Add Arr(i, 4), s
End If
ArrKQ(s, 5) = ArrKQ(s, 5) + Arr(i, 6)
Next i
With Sheets("Summary")
With .Range("M3")
.Resize(s, 5) = ArrKQ
End With
End With
Erase ArrKQ
For i = 1 To UBound(arrTach)
ArrKQ(i, 1) = Trim(Left(Replace(arrTach(i, 1), ".", Space(10)), 10))
Next i
With Sheets("Summary")
With .Range("M3")
.Offset(0, 3).Resize(i, 1) = ArrKQ
End With
End With
Set Dic = Nothing
Erase Arr, ArrKQ, arrTach
MsgBox Timer - T
End Sub
PHP:
Sub TaoSource02()
Dim endR As Long
Dim Arr(), ArrKQ(1 To 65000, 1 To 5), ArrXX(1 To 65000, 1 To 1)
Dim T
T = Timer
ThisWorkbook.Activate
With Sheets("T7-2010")
endR = .Cells(65000, 1).End(xlUp).Row
Arr = .Range(.Cells(2, 1), .Cells(endR + 1, 7)).Value
End With
s = 1
For i = 1 To UBound(Arr) - 1
ArrKQ(s, 1) = s
ArrKQ(s, 2) = Arr(i, 1)
ArrKQ(s, 3) = Arr(i, 3)
ArrXX(s, 1) = Arr(i, 4)
ArrKQ(s, 4) = Trim(Left(Replace(Arr(i, 4), ".", Space(10)), 10))
ArrKQ(s, 5) = ArrKQ(s, 5) + Arr(i, 6)
If Arr(i + 1, 4) <> ArrXX(s, 1) Then s = s + 1
Next i
With Sheets("Summary")
With .Range("S3")
.Resize(s, 5) = ArrKQ
End With
End With
Erase Arr, ArrKQ, ArrXX
MsgBox Timer - T
End Sub
Lần chỉnh sửa cuối:
mình kéo công thức xuống thì thấy cột source thì thấy ko hiện kết quả.
riêng cột item thì kéo xuống thì bị lặp lại
---------------
Tập tin đính kèm
riêng cột item thì kéo xuống thì bị lặp lại
---------------
Bạn xem trong file có đúng ý bạn không nhé!
- T7-2010.xls (32.5 KB, 17 lần tải)
Skype: minhtien.hoang
Gmail : minhtien.hoang
Phone : 0983912383
Công thức hàm Excel
Những tuyệt chiêu Excel
Gmail : minhtien.hoang
Phone : 0983912383
Công thức hàm Excel
Những tuyệt chiêu Excel
Bạn xem file sau thử nhé.
boyxin
Members actively
- Tham gia
- 10/3/08
- Bài viết
- 1,664
- Được thích
- 2,335
Theo ngu ý của thảo dân, giải pháp dùng "PivotTables" để quản lý bảng 2 sẽ đơn giản và không hề kéo dài thời gian xử lý dữ liệu
(Mong chờ cao kiến của các bác ...
)-----------------
Bảng 1 quản lý Source theo code ThuNghi cung cấp
Lần chỉnh sửa cuối:
- Tham gia
- 4/11/07
- Bài viết
- 14,501
- Được thích
- 37,175
- Donate (Momo)
- Giới tính
- Nam
- Nghề nghiệp
- Consultant
Cải tiến code của Thu Nghi:
Code TaoSource3 nếu thay đoạn code này:
Bằng cách gán thẳng vào ArrKQ(i, 4) và dùng Instr() thay cho replace, sẽ giảm 1/3 thời gian:
Tương tự Code TaoSource02 cũng dùng Instr(), giảm 1/6 thời gian. Taosource02 dùng toàn Array, vẫn nhanh hơn Taosource3 dùng Array phối hợp Dict:
Taosource3 Thu Nghi: 0.875s
Taosource3 ptm: 0.5475s
Taosource02 ThuNghi: 0.54s
Taosource02 ptm: 0.48s
Code TaoSource3 nếu thay đoạn code này:
PHP:
For i = 1 To UBound(arrTach)
ArrKQ(i, 1) = Trim(Left(Replace(arrTach(i, 1), ".", Space(10)), 10))
Next i
With Sheets("Summary")
With .Range("M3")
.Offset(0, 3).Resize(i, 1) = ArrKQ
End With
End WithBằng cách gán thẳng vào ArrKQ(i, 4) và dùng Instr() thay cho replace, sẽ giảm 1/3 thời gian:
PHP:
ArrKQ(s, 4) = Left(Arr(i, 4), InStr(1, Arr(i, 4), ".") - 1)Tương tự Code TaoSource02 cũng dùng Instr(), giảm 1/6 thời gian. Taosource02 dùng toàn Array, vẫn nhanh hơn Taosource3 dùng Array phối hợp Dict:
Taosource3 Thu Nghi: 0.875s
Taosource3 ptm: 0.5475s
Taosource02 ThuNghi: 0.54s
Taosource02 ptm: 0.48s
Lần chỉnh sửa cuối:
Bài viết mới nhất
- Question
- Question
- Đã giải quyết
- Question
