Dùng DIC cho kết quả không đúng (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Cá ngừ F1

Cá ngừ F1

( ͡° ͜ʖ ͡°)
Thành viên BQT
Moderator
Tham gia
1/1/08
Bài viết
2,579
Được thích
3,723
Donate (Momo)
Donate
Giới tính
Nam
Nghề nghiệp
Quan hệ.. và quan hệ..
Em có mò mẫm code trên GPE, thay thế cho phương thức Find chuyển sang DIC cho nhanh. Em xin phép hỏi một số nội dung sau:
1. Code cho kết quả sai (chưa tìm ra nguyên nhân)

2. Nếu thay tham chiếu về 10000
Mã: 
....
ST = .Range([COLOR=#ff0000].[T2], .[T10000][/COLOR].End(3)).Value
....
CL = .Range([COLOR=#ff0000].[E2], .[E10000][/COLOR].End(3)).Resize(, 8).Value
Thì báo lỗi: Run-time error '1004': Application-defined or object-defined

3. Có cách khác để tối ưu code không ạh?
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Cá ngừ F1 đã viết:
Em có mò mẫm code trên GPE, thay thế cho phương thức Find chuyển sang DIC cho nhanh. Em xin phép hỏi một số nội dung sau:
1. Code cho kết quả sai (chưa tìm ra nguyên nhân)

2. Nếu thay tham chiếu về 10000
Mã: 
....
ST = .Range([COLOR=#ff0000].[T2], .[T10000][/COLOR].End(3)).Value
....
CL = .Range([COLOR=#ff0000].[E2], .[E10000][/COLOR].End(3)).Resize(, 8).Value
Thì báo lỗi: Run-time error '1004': Application-defined or object-defined

3. Có cách khác để tối ưu code không ạh?
Nhấp chuột vào đây để mở rộng...
Viết tầm bậy mà sao code hiểu được chứ... ka ka ka. Nghiên cứu tiếp đi
 
Upvote 0
Cá ngừ F1 đã viết:
Em có mò mẫm code trên GPE, thay thế cho phương thức Find chuyển sang DIC cho nhanh. Em xin phép hỏi một số nội dung sau:
1. Code cho kết quả sai (chưa tìm ra nguyên nhân)

2. Nếu thay tham chiếu về 10000
Mã: 
....
ST = .Range([COLOR=#ff0000].[T2], .[T10000][/COLOR].End(3)).Value
....
CL = .Range([COLOR=#ff0000].[E2], .[E10000][/COLOR].End(3)).Resize(, 8).Value
Thì báo lỗi: Run-time error '1004': Application-defined or object-defined

3. Có cách khác để tối ưu code không ạh?
Nhấp chuột vào đây để mở rộng...
Chưa mở file ra để xem đã nhìn thấy lỗi cú pháp ở chỗ màu đỏ( ).
 
Lần chỉnh sửa cuối:
Upvote 0
Cá ngừ F1 đã viết:
Em có mò mẫm code trên GPE, thay thế cho phương thức Find chuyển sang DIC cho nhanh. Em xin phép hỏi một số nội dung sau:
1. Code cho kết quả sai (chưa tìm ra nguyên nhân)

2. Nếu thay tham chiếu về 10000
Mã: 
....
ST = .Range([COLOR=#ff0000].[T2], .[T10000][/COLOR].End(3)).Value
....
CL = .Range([COLOR=#ff0000].[E2], .[E10000][/COLOR].End(3)).Resize(, 8).Value
Thì báo lỗi: Run-time error '1004': Application-defined or object-defined

3. Có cách khác để tối ưu code không ạh?
Nhấp chuột vào đây để mở rộng...
Sửa lại vầy
***
Khai báo biến chẳng có ấn tượng gì ráo
PS: Nếu dữ liệu ít thì hàm Find nhanh hơn, nếu nhiều thì phải dùng Dic thôi. Dic thì ai cũng khoái hết
PHP: 
Sub FindDate()
Dim t As Long
t = Timer
Dim Code(), Source(), Ngay(), I
Dim Found As Range
With Sheet5
   Code = .Range(.[T2], .[T65536].End(3)).Value
End With
With Sheet9
   Source = .Range(.[E2], .[E65536].End(3)).Resize(, 8)
End With
ReDim Ngay(1 To UBound(Code), 1 To 1)
With CreateObject("scripting.dictionary")
   For I = 1 To UBound(Source)
      If Not .exists(Source(I, 1)) Then
         .Add Source(I, 1), Source(I, 8)
      End If
   Next
   For I = 1 To UBound(Code)
      If .exists(Code(I, 1)) Then
         Ngay(I, 1) = .Item(Code(I, 1))
      End If
   Next
End With
Sheet5.[Z2].Resize(I - 1, 1) = Ngay
MsgBox Timer - t
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
quanghai1969 đã viết:
Sửa lại vầy
***
Khai báo biến chẳng có ấn tượng gì ráo
PS: Nếu dữ liệu ít thì hàm Find nhanh hơn, nếu nhiều thì phải dùng Dic thôi. Dic thì ai cũng khoái hết
PHP: 
Sub FindDate()
Dim t As Long
t = Timer
Dim Code(), Source(), Ngay(), I, J, K
Dim Found As Range
With Sheet5
   Code = .Range(.[T2], .[T65536].End(3)).Value
End With
With Sheet9
   Source = .Range(.[E2], .[E65536].End(3)).Resize(, 8)
End With
ReDim Ngay(1 To UBound(Code), 1 To 1)
With CreateObject("scripting.dictionary")
   For I = 1 To UBound(Source)
      If Not .exists(Source(I, 1)) Then
         .Add Source(I, 1), Source(I, 8)
      End If
   Next
   For I = 1 To UBound(Code)
      If .exists(Code(I, 1)) Then
         Ngay(I, 1) = .Item(Code(I, 1))
      End If
   Next
End With
Sheet5.[Z2].Resize(I - 1, 1) = Ngay
MsgBox Timer - t
End Sub
Nhấp chuột vào đây để mở rộng...
hì, e cảm ơn anh... e học tập chưa tới nơi tới chốn, hjk, nhìn khai báo đã thấy chuyên nghiệp rồi...
 
Upvote 0
quanghai1969 đã viết:
Sửa lại vầy
***
Khai báo biến chẳng có ấn tượng gì ráo
PS: Nếu dữ liệu ít thì hàm Find nhanh hơn, nếu nhiều thì phải dùng Dic thôi. Dic thì ai cũng khoái hết
PHP: 
Sub FindDate()
Dim t As Long
t = Timer
Dim Code(), Source(), Ngay(), I
Dim Found As Range
With Sheet5
   Code = .Range(.[T2], .[T65536].End(3)).Value
End With
With Sheet9
   Source = .Range(.[E2], .[E65536].End(3)).Resize(, 8)
End With
ReDim Ngay(1 To UBound(Code), 1 To 1)
With CreateObject("scripting.dictionary")
   For I = 1 To UBound(Source)
      If Not .exists(Source(I, 1)) Then
         .Add Source(I, 1), Source(I, 8)
      End If
   Next
   For I = 1 To UBound(Code)
      If .exists(Code(I, 1)) Then
         Ngay(I, 1) = .Item(Code(I, 1))
      End If
   Next
End With
Sheet5.[Z2].Resize(I - 1, 1) = Ngay
MsgBox Timer - t
End Sub
Nhấp chuột vào đây để mở rộng...
Find e cũng học mót của anh
Jo dữ liệu nhiều chạy find tèo luôn ạh
 
Upvote 0
quanghai1969 đã viết:
Chẳng có cái code nào của mình cả, toàn là của GPE hết thôi mà. Chẳng qua là mình học được trước chút.
Nhấp chuột vào đây để mở rộng...
Dạ..e cũng đọc nhiều code Find..tuy nhiên thì cách viết của a nhìn rất dễ hiểu ạh..ma sang đến dic thì cũng hơi mơ màng quá ạh
E cảm ơn anh nhieu!!!
 
Upvote 0
quanghai1969 đã viết:
Chẳng có cái code nào của mình cả, toàn là của GPE hết thôi mà. Chẳng qua là mình học được trước chút.
Nhấp chuột vào đây để mở rộng...
a Hải ạh
Ko hiểu sao? e áp dụng vào bài của e, vị trí các trường ko khác j file đính kèm, mà code chạy tận gần 50', hjk, +-+-+-+
 
Upvote 0
Cá ngừ F1 đã viết:
a Hải ạh
Ko hiểu sao? e áp dụng vào bài của e, vị trí các trường ko khác j file đính kèm, mà code chạy tận gần 50', hjk, +-+-+-+
Nhấp chuột vào đây để mở rộng...
File có bao nhiều dòng dữ liệu? 50 phút hay 50 giây? Thông thường ký hiệu 50' là 50 phút thì phải. >>> Khâm phục sự kiên nhẫn
 
Upvote 0
53 giây ạh
Sheet ngay có gần 50,000 dòng
Sheet Ma có gần 10,000 dòng
 
Upvote 0
quanghai1969 đã viết:
Cho cái đoạn code đang áp dụng lên xem nào, 53s cũng vô lý quá
Cho luôn cái file dữ liệu lên, chỉ cho mấy cột cần thiết thôi cho nhẹ
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub FindDate()
Dim t As Long
t = Timer
Dim Code(), Source(), Ngay(), I
Dim Found As Range
With Sheet5
   Code = .Range(.[T2], .[T65536].End(3)).Value
End With
With Sheet9
   Source = .Range(.[E2], .[E65536].End(3)).Resize(, 8)
End With
ReDim Ngay(1 To UBound(Code), 1 To 1)
With CreateObject("scripting.dictionary")
   For I = 1 To UBound(Source)
      If Not .exists(Source(I, 1)) Then
         .Add Source(I, 1), Source(I, 8)
      End If
   Next
   For I = 1 To UBound(Code)
      If .exists(Code(I, 1)) Then
         Ngay(I, 1) = .Item(Code(I, 1))
      End If
   Next
End With
Sheet5.[Z2].Resize(I - 1, 1) = Ngay
MsgBox Timer - t
End Sub
Dạ, e cũng thấy vô lý, hjk
 
Upvote 0
Cá ngừ F1 đã viết:
Mã: 
Sub FindDate()
Dim t As Long
t = Timer
Dim Code(), Source(), Ngay(), I
Dim Found As Range
With Sheet5
   Code = .Range(.[T2], .[T65536].End(3)).Value
End With
With Sheet9
   Source = .Range(.[E2], .[E65536].End(3)).Resize(, 8)
End With
ReDim Ngay(1 To UBound(Code), 1 To 1)
With CreateObject("scripting.dictionary")
   For I = 1 To UBound(Source)
      If Not .exists(Source(I, 1)) Then
         .Add Source(I, 1), Source(I, 8)
      End If
   Next
   For I = 1 To UBound(Code)
      If .exists(Code(I, 1)) Then
         Ngay(I, 1) = .Item(Code(I, 1))
      End If
   Next
End With
Sheet5.[Z2].Resize(I - 1, 1) = Ngay
MsgBox Timer - t
End Sub
Dạ, e cũng thấy vô lý, hjk
Nhấp chuột vào đây để mở rộng...

Mình để ý thấy thế này, với 50k dòng thì nạp vào Dic chưa tới 1s mà, đằng này chỉ có 10k dòng thì ăn nhầm gì.
Cốc có biết trừ khi có file...
 
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
Cá ngừ F1 đã viết:
E xin pốt file lên ạh
Nhấp chuột vào đây để mở rộng...
Thử code này coi thế nào nha
PHP: 
Sub FindDate()
Dim t As Long
t = Timer
Dim Code(), Source(), Ngay(), I
Dim Found As Range
With Sheet5
   Code = .Range(.[T2], .[T65536].End(3)).Value
End With
With Sheet9
   Source = .Range(.[E2], .[E65536].End(3)).Resize(, 9).Value
End With
ReDim Ngay(1 To UBound(Code), 1 To 1)
With CreateObject("scripting.dictionary")
   For I = 1 To UBound(Source)
      If Not .exists(CStr(Source(I, 1))) Then
         .Add CStr(Source(I, 1)), Source(I, 9)
      End If
   Next
   For I = 1 To UBound(Code)
      If .exists(CStr(Code(I, 1))) Then
         Ngay(I, 1) = .Item(CStr(Code(I, 1)))
      End If
   Next
End With
Sheet5.[Z2].Resize(I - 1, 1) = Ngay
MsgBox Timer - t
End Sub
 
Upvote 0
Cá ngừ F1 đã viết:
E copy hơi vắn tắt, mong sư phụ chỉ dậy...
Nhấp chuột vào đây để mở rộng...
Code của cá ngừ đang đúng và chạy, sửa 1 triệu thành 10.000 thì bị lỗi. Như vậy theo tôi không phải sai cú pháp.

MUốn biết sai thế nào thì tôi phải xem file, xem code, sửa 1 triệu thành 10.000 và chạy thử, hoặc nhanh mắt thì xem dữ liệu.

Còn chuot không xem file mà có thể tuyên bố sai, lại còn biết là sai cú pháp, nên tôi phải hỏi chuot để học.
 
Upvote 0
quanghai1969 đã viết:
Thử code này coi thế nào nha
PHP: 
Sub FindDate()
Dim t As Long
t = Timer
Dim Code(), Source(), Ngay(), I
Dim Found As Range
With Sheet5
   Code = .Range(.[T2], .[T65536].End(3)).Value
End With
With Sheet9
   Source = .Range(.[E2], .[E65536].End(3)).Resize(, 9).Value
End With
ReDim Ngay(1 To UBound(Code), 1 To 1)
With CreateObject("scripting.dictionary")
   For I = 1 To UBound(Source)
      If Not .exists(CStr(Source(I, 1))) Then
         .Add CStr(Source(I, 1)), Source(I, 9)
      End If
   Next
   For I = 1 To UBound(Code)
      If .exists(CStr(Code(I, 1))) Then
         Ngay(I, 1) = .Item(CStr(Code(I, 1)))
      End If
   Next
End With
Sheet5.[Z2].Resize(I - 1, 1) = Ngay
MsgBox Timer - t
End Sub
Nhấp chuột vào đây để mở rộng...
Mấu chốt ở chỗ này đúng ko ạh? a có thể giải thích thêm đc ko? khi nào cho cái đỏ đỏ (CStr) vào? khi nào ko?
 
Lần chỉnh sửa cuối:
Upvote 0
Cá ngừ F1 đã viết:
Mấu chốt ở chỗ này đúng ko ạh? a có thể giải thích thêm đc ko? khi nào cho cái đỏ đỏ vào? khi nào ko?
Nhấp chuột vào đây để mở rộng...
Quan trọng là kết quả thế nào, chỗ nào đỏ đỏ có biết đâu.. Thấy xanh lè hết trơn mà

****

Giao trước là không hỏi tại sao nha. Mình toàn đánh võ rừng thôi. Chỉ làm theo cảm giác
 
Upvote 0
Upvote 0
Cá ngừ F1 đã viết:
Mấu chốt ở chỗ này đúng ko ạh? a có thể giải thích thêm đc ko? khi nào cho cái đỏ đỏ (CStr) vào? khi nào ko?
Nhấp chuột vào đây để mở rộng...
Thật tình mà nói thì mình cũng bất ngờ khi kết quả chưa đầy 1s. Còn tại sao thì phải đợi các thầy có chuyên môn giải thích. Lúc thêm cái này vào mình chỉ suy luận bằng cảm giác. Thử mấy cái, cuối cùng cái này ok thì ... quất. Nói thiệt là không biết hậu quả nha
 
Upvote 0
quanghai1969 đã viết:
Quan trọng là kết quả thế nào, chỗ nào đỏ đỏ có biết đâu.. Thấy xanh lè hết trơn mà

****

Giao trước là không hỏi tại sao nha. Mình toàn đánh võ rừng thôi. Chỉ làm theo cảm giác
Nhấp chuột vào đây để mở rộng...
Phải nói là quá nhanh, 0.5s
Giá mà e cũng có cảm giác như anh, ặc ặc... +-+-+-+
 
Upvote 0
quanghai1969 đã viết:
Thật tình mà nói thì mình cũng bất ngờ khi kết quả chưa đầy 1s. Còn tại sao thì phải đợi các thầy có chuyên môn giải thích. Lúc thêm cái này vào mình chỉ suy luận bằng cảm giác. Thử mấy cái, cuối cùng cái này ok thì ... quất. Nói thiệt là không biết hậu quả nha
Nhấp chuột vào đây để mở rộng...
Vậy e xin pốt lại file để các thầy/anh/chị giải thích thêm... và có thể có cách khác tương tự ko ạh?
 

File đính kèm

Upvote 0
Cá ngừ F1 đã viết:
Anh Nghĩa ạh... mục đích là để tìm kiếm thôi ạh...
Nhấp chuột vào đây để mở rộng...
Với đoạn code này:

Mã: 
   For I = 1 To UBound(Source)
      If Not .exists(Source(I, 1)) Then
         .Add Source(I, 1), [COLOR=#ff0000][B]Source(I, 9)[/B][/COLOR]
      End If
   Next

Cái màu đỏ để làm gì thế?
 
Upvote 0
Upvote 0
Upvote 0
Cá ngừ F1 đã viết:
Theo ý em hiểu là để lấy cột số 9 ạh
Nhấp chuột vào đây để mở rộng...

Nếu như thế thì tại sao bạn không tạo 2 mảng 1 cột để thực thi sẽ nhanh hơn rất nhiều so với một mảng gồm cả 9 cột dữ liệu hay không?

Mã: 
Sub FindDate()
    Dim i As Long
    Dim Code, Source1, Source9, Ngay, Itm
    Dim Found As Range, MyRng As Range


    With Sheet5
        Code = .Range(.[T2], .[T65536].End(3)).Value
    End With


[COLOR=#0000ff]    With Sheet9[/COLOR]
[COLOR=#0000ff]        Set MyRng = .Range(.[E2], .[E65536].End(3))[/COLOR]
[COLOR=#0000ff]        Source1 = MyRng[/COLOR]
[COLOR=#0000ff]        Source9 = MyRng.Offset(, 8)[/COLOR]
[COLOR=#0000ff]    End With[/COLOR]
[COLOR=#0000ff]    [/COLOR]
    ReDim Ngay(1 To UBound(Code), 1 To 1)
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(Source1)
[COLOR=#008080]            Itm = Source1(i, 1)[/COLOR]
            If [COLOR=#ff0000]Itm > ""[/COLOR] And Not .exists(Itm) Then
[COLOR=#ff0000]            .Add Itm, [/COLOR][COLOR=#0000cd]Source9(i, 1)[/COLOR][COLOR=#ff0000][/COLOR]
            End If
        Next
''.................
    End With
End Sub
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Nếu như thế thì tại sao bạn không tạo 2 mảng 1 cột để thực thi sẽ nhanh hơn rất nhiều so với một mảng gồm cả 9 cột dữ liệu hay không?

Mã: 
Sub FindDate()
    Dim i As Long
    Dim Code, Source1, Source9, Ngay, Itm
    Dim Found As Range, MyRng As Range


    With Sheet5
        Code = .Range(.[T2], .[T65536].End(3)).Value
    End With


[COLOR=#0000ff]    With Sheet9[/COLOR]
[COLOR=#0000ff]        Set MyRng = .Range(.[E2], .[E65536].End(3))[/COLOR]
[COLOR=#0000ff]        Source1 = MyRng[/COLOR]
[COLOR=#0000ff]        Source9 = MyRng.Offset(, 8)[/COLOR]
[COLOR=#0000ff]    End With[/COLOR]

    ReDim Ngay(1 To UBound(Code), 1 To 1)
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(Source1)
[COLOR=#008080]            Itm = Source1(i, 1)[/COLOR]
            If [COLOR=#ff0000]Itm > ""[/COLOR] And Not .exists(Itm) Then
[COLOR=#ff0000]            .Add Itm, [/COLOR][COLOR=#0000cd]Source9(i, 1)[/COLOR]
            End If
        Next
''.................
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Vậy viết hết đoạn code xem coi chạy nhanh hơn bao nhiêu. Tui thấy chưa đầy 1s là sướng lắm rồi.
 
Upvote 0
quanghai1969 đã viết:
Vậy viết hết đoạn code xem coi chạy nhanh hơn bao nhiêu. Tui thấy chưa đầy 1s là sướng lắm rồi.
Nhấp chuột vào đây để mở rộng...
Đâu thử xem có cải thiện được tốc độ được không.

Mã: 
Sub FindDate()


Dim t As Double
t = Timer
    
    Dim i As Long
    Dim MyRng As Range
    Dim Code, Source1, Source9, Ngay, Itm


    With Sheet5
        Code = Range(.Range("T2"), .Range("T65536").End(xlUp))
    End With


    With Sheet9
        Set MyRng = Range(.Range("E2"), .Range("E65536").End(xlUp))
        Source1 = MyRng
        Source9 = MyRng.Offset(, 8)
    End With
    
    ReDim Ngay(1 To UBound(Code), 1 To 1)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Source1)
            Itm = CStr(Source1(i, 1))
            If Itm > "" And Not .Exists(Itm) Then
                .Add Itm, Source9(i, 1)
            End If
        Next
        For i = 1 To UBound(Code)
            Itm = CStr(Code(i, 1))
[COLOR=#ff0000]            If .Exists(Itm) Then[/COLOR]
                Ngay(i, 1) = .Item(Itm)
            End If
        Next
    End With
    
    Sheet5.Range("Z2").Resize(i - 1, 1) = Ngay
    
MsgBox Timer - t

End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Đâu thử xem có cải thiện được tốc độ được không.

Mã: 
Sub FindDate()


Dim t As Double
t = Timer
    
    Dim i As Long
    Dim MyRng As Range
    Dim Code, Source1, Source9, Ngay, Itm


    With Sheet5
        Code = Range(.Range("T2"), .Range("T65536").End(xlUp))
    End With


    With Sheet9
        Set MyRng = Range(.Range("E2"), .Range("E65536").End(xlUp))
        Source1 = MyRng
        Source9 = MyRng.Offset(, 8)
    End With
    
    ReDim Ngay(1 To UBound(Code), 1 To 1)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Source1)
            Itm = CStr(Source1(i, 1))
            If Itm > "" And Not .Exists(Itm) Then
                .Add Itm, Source9(i, 1)
            End If
        Next
        For i = 1 To UBound(Code)
            Itm = CStr(Code(i, 1))
[COLOR=#ff0000]            If .Exists(Itm) Then[/COLOR]
                Ngay(i, 1) = .Item(Itm)
            End If
        Next
    End With
    
    Sheet5.Range("Z2").Resize(i - 1, 1) = Ngay
    
MsgBox Timer - t

End Sub
Nhấp chuột vào đây để mở rộng...

Phải công nhận là nhanh hơn tẹo, nhưng cũng không đáng bao nhiêu. Tuy nhiên trong bài này mình lại rút ra 1 kinh nghiệm khi ứng dụng Dic
Dữ liệu nào vào phải chú ý loại dữ liệu gì. Trước giờ cốc có biết, cái vụ này phải cảm ơn F1 nha
 
Upvote 0
quanghai1969 đã viết:
Phải công nhận là nhanh hơn tẹo, nhưng cũng không đáng bao nhiêu. Tuy nhiên trong bài này mình lại rút ra 1 kinh nghiệm khi ứng dụng Dic
Dữ liệu nào vào phải chú ý loại dữ liệu gì. Trước giờ cốc có biết, cái vụ này phải cảm ơn F1 nha
Nhấp chuột vào đây để mở rộng...

Vấn đề nhanh hay chậm vẫn còn tùy, nhưng với code thì phải tư duy và tận dụng cái gì mình cần nạp dữ liệu để tránh việc nạp thừa không cần thiết thôi.
 
Upvote 0
quanghai1969 đã viết:
Phải công nhận là nhanh hơn tẹo, nhưng cũng không đáng bao nhiêu. Tuy nhiên trong bài này mình lại rút ra 1 kinh nghiệm khi ứng dụng Dic
Dữ liệu nào vào phải chú ý loại dữ liệu gì. Trước giờ cốc có biết, cái vụ này phải cảm ơn F1 nha
Nhấp chuột vào đây để mở rộng...
Như vậy là dù dữ liêu thế nào cứ thêm CStr để biến thành text hết cho đồng bộ đúng ko ạh?
 
Upvote 0
Cá ngừ F1 đã viết:
Như vậy là dù dữ liêu thế nào cứ thêm CStr để biến thành text hết cho đồng bộ đúng ko ạh?
Nhấp chuột vào đây để mở rộng...

Hiểu vậy là... trật lất nha!
Vấn đề là... còn nhiều thứ phải học, phải làm nhiều rồi tự rút ra kinh nghiệm
Tóm lại: Mai này sẽ biết
Ẹc... Ẹc...
 
Upvote 0
Cá ngừ F1 đã viết:
Như vậy là dù dữ liêu thế nào cứ thêm CStr để biến thành text hết cho đồng bộ đúng ko ạh?
Nhấp chuột vào đây để mở rộng...
Công nhận đưa ra 1 quyết định thấy ghê thiệt. Mình chả hiểu, nhưng cứ dùng cái cảm giác mà xấn tới.... Vì mình thấy cái item code nó chứa tới 14 ký tự và mình có cảm giác nếu để nó dạng số thì nó mệt, vậy là chuyển thừ, ai dè đâu hiệu quả...
 
Upvote 0
ndu96081631 đã viết:
Hiểu vậy là... trật lất nha!
Vấn đề là... còn nhiều thứ phải học, phải làm nhiều rồi tự rút ra kinh nghiệm
Tóm lại: Mai này sẽ biết
Ẹc... Ẹc...
Nhấp chuột vào đây để mở rộng...
Thấy thầy NDU lấp ló mà ko thấy pm j, cơ mà câu này làm e cần cố gắng hơn nữa... +-+-+-+
 
Upvote 0
Cá ngừ F1 đã viết:
Dạ.. e vẫn đang mong khai quốc công thần triển khai đó ah..
Nhấp chuột vào đây để mở rộng...
Mình mạo muội triển khai cho cai code này dùng Dic, chạy nhanh hơn chút. Bảo đảm xem code này xong là F1 khỏi xem nổi trận chung kết luôn. Code thì có sẵn đấy, đề nghị không yêu cầu giải thích gì ráo. Chắc ăn rằng mai này sẽ biết
PHP: 
Sub FindDate()
Dim T As Double, X
T = Timer
'For X = 1 To 10
Dim Code(), Source(), Ngay(), I, Dic As Object
Dim Found As Range
Set Dic = CreateObject("scripting.dictionary")
With Sheet5
   Code = .Range(.[T2], .[T65536].End(3)).Value
    With Sheet9
       Source = .Range(.[E2], .[E65536].End(3)).Resize(, 9).Value
    End With
    ReDim Ngay(1 To UBound(Code), 1 To 1)
    For I = 1 To UBound(Source)
        Dic(CStr(Source(I, 1))) = Source(I, 9)
    Next
    For I = 1 To UBound(Code)
        If Code(I, 1) <> "" Then
            Ngay(I, 1) = Dic.Item(CStr(Code(I, 1)))
        End If
    Next
    .[Z2].Resize(I - 1, 1) = Ngay
End With
'Next
MsgBox Timer - T
End Sub
 
Upvote 0
quanghai1969 đã viết:
Mình mạo muội triển khai cho cai code này dùng Dic, chạy nhanh hơn chút. Bảo đảm xem code này xong là F1 khỏi xem nổi trận chung kết luôn. Code thì có sẵn đấy, đề nghị không yêu cầu giải thích gì ráo. Chắc ăn rằng mai này sẽ biết
PHP: 
Sub FindDate()
Dim T As Double, X
T = Timer
'For X = 1 To 10
Dim Code(), Source(), Ngay(), I, Dic As Object
Dim Found As Range
Set Dic = CreateObject("scripting.dictionary")
With Sheet5
   Code = .Range(.[T2], .[T65536].End(3)).Value
    With Sheet9
       Source = .Range(.[E2], .[E65536].End(3)).Resize(, 9).Value
    End With
    ReDim Ngay(1 To UBound(Code), 1 To 1)
    For I = 1 To UBound(Source)
        Dic(CStr(Source(I, 1))) = Source(I, 9)
    Next
    For I = 1 To UBound(Code)
        If Code(I, 1) <> "" Then
            Ngay(I, 1) = Dic.Item(CStr(Code(I, 1)))
        End If
    Next
    .[Z2].Resize(I - 1, 1) = Ngay
End With
'Next
MsgBox Timer - T
End Sub
Nhấp chuột vào đây để mở rộng...
Vô cùng cảm ơn a.. trước trận BA TƯ hôm nay e sẽ mần xem sao..
 
Upvote 0
quanghai1969 đã viết:
Mình mạo muội triển khai cho cai code này dùng Dic, chạy nhanh hơn chút. Bảo đảm xem code này xong là F1 khỏi xem nổi trận chung kết luôn. Code thì có sẵn đấy, đề nghị không yêu cầu giải thích gì ráo. Chắc ăn rằng mai này sẽ biết
PHP: 
Sub FindDate()
Dim T As Double, X
T = Timer
'For X = 1 To 10
Dim Code(), Source(), Ngay(), I, Dic As Object
Dim Found As Range
Set Dic = CreateObject("scripting.dictionary")
With Sheet5
   Code = .Range(.[T2], .[T65536].End(3)).Value
    With Sheet9
       Source = .Range(.[E2], .[E65536].End(3)).Resize(, 9).Value
    End With
    ReDim Ngay(1 To UBound(Code), 1 To 1)
    For I = 1 To UBound(Source)
        Dic(CStr(Source(I, 1))) = Source(I, 9)
    Next
    For I = 1 To UBound(Code)
        If Code(I, 1) <> "" Then
            Ngay(I, 1) = Dic.Item(CStr(Code(I, 1)))
        End If
    Next
    .[Z2].Resize(I - 1, 1) = Ngay
End With
'Next
MsgBox Timer - T
End Sub
Nhấp chuột vào đây để mở rộng...
Đang mần mà thấy phê thật ạh.. roẹt... 0.28s
 
Upvote 0
quanghai1969 đã viết:
Mình mạo muội triển khai cho cai code này dùng Dic, chạy nhanh hơn chút. Bảo đảm xem code này xong là F1 khỏi xem nổi trận chung kết luôn. Code thì có sẵn đấy, đề nghị không yêu cầu giải thích gì ráo. Chắc ăn rằng mai này sẽ biết
PHP: 
Sub FindDate()
Dim T As Double, X
T = Timer
'For X = 1 To 10
Dim Code(), Source(), Ngay(), I, Dic As Object
Dim Found As Range
Set Dic = CreateObject("scripting.dictionary")
With Sheet5
   Code = .Range(.[T2], .[T65536].End(3)).Value
    With Sheet9
       Source = .Range(.[E2], .[E65536].End(3)).Resize(, 9).Value
    End With
    ReDim Ngay(1 To UBound(Code), 1 To 1)
    For I = 1 To UBound(Source)
        Dic(CStr(Source(I, 1))) = Source(I, 9)
    Next
    For I = 1 To UBound(Code)
        If Code(I, 1) <> "" Then
            Ngay(I, 1) = Dic.Item(CStr(Code(I, 1)))
        End If
    Next
    .[Z2].Resize(I - 1, 1) = Ngay
End With
'Next
MsgBox Timer - T
End Sub
Nhấp chuột vào đây để mở rộng...
E đang mần Code a Nghĩa mới khai triển... roẹt... 0.17s... tỉnh hết cả ngủ ạh
Mã: 
Sub FindDate2()


Dim t As Double
t = Timer
    
    Dim i As Long
    Dim MyRng As Range
    Dim Code, Source1, Source9, Ngay, Itm, Dict1


    With Sheet5
        Code = Range(.Range("T2"), .Range("T65536").End(xlUp))
    End With


    With Sheet9
        Set MyRng = Range(.Range("E2"), .Range("E65536").End(xlUp))
        Source1 = MyRng
        Source9 = MyRng.Offset(, 8)
    End With
    
    ReDim Ngay(1 To UBound(Code), 1 To 1)
    
    Set Dict1 = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(Source1)
        Dict1(CStr(Source1(i, 1))) = Source9(i, 1)
    Next
    
    For i = 1 To UBound(Code)
        If Code(i, 1) <> "" Then
            Ngay(i, 1) = Dict1.Item(CStr(Code(i, 1)))
        End If
    Next
    
    Sheet5.Range("Z2").Resize(i - 1, 1) = Ngay
    
MsgBox Timer - t


End Sub
 
Upvote 0
quanghai1969 đã viết:
Quan trọng là có hiểu được thuật toán trong code hay không, nếu không hiểu đụng bài khác thì coi như số 0
Nhấp chuột vào đây để mở rộng...
Dạ.. mấy bài trên còn hiểu và chỉnh sửa được, từ #46 của a là thấy căng rồi ạh
E cũng cố gắng
Như trước qua một số bài phương thức Find của a.. mà mãi mài mai mới lĩnh hội được ạh...
 
Upvote 0
quanghai1969 đã viết:
Quan trọng là có hiểu được thuật toán trong code hay không, nếu không hiểu đụng bài khác thì coi như số 0
Nhấp chuột vào đây để mở rộng...
Thật ra cách của anh Hải là mới mẻ, tuy nhiên có khác ở chỗ này để cùng thảo luận rõ vấn đề.

Với kiểu add này:

(1) Dict1(CStr(Source1(i, 1))) = Source9(i, 1)

Đặc biệt giống kiểu Boolean, nhưng khác kiểu thông thường mà chúng ta gặp trên diễn đàn:

(2) Dict1.Add CStr(Source1(i, 1))), Source9(i, 1)

Với (2) khi Add kiểu này nó đòi hỏi ta phải Add với giá trị phải không trùng, nếu trùng sẽ gặp lỗi. Vì thế ta phải ràng buộc thêm điều kiện Exists vào để tránh tình trạng trùng.

Với (1), khi thực hiện cách này, thì nếu Key chưa tồn tại thì key đó được Add vào, nếu đã tồn tại và nếu không sử dụng Exists thì key đã tồn tại sẽ cập nhật mới Item tại key đó.

Vì thế với bài này hãy thật sự cẩn thận với cách dùng trực tiếp mà không thông qua Exists vì nếu Key trùng giả sử 10 hàng có key là 1 và các số của item có giá trị từ 1 đến 10 thì kết quả cuối cùng của Key(1) sẽ là 10 (nó thay thế từ 1 đến 10 tại key 1).
 
Lần chỉnh sửa cuối:
Upvote 0
Cá ngừ F1 đã viết:
Dạ.. mấy bài trên còn hiểu và chỉnh sửa được, từ #46 của a là thấy căng rồi ạh
E cũng cố gắng
Như trước qua một số bài phương thức Find của a.. mà mãi mài mai mới lĩnh hội được ạh...
Nhấp chuột vào đây để mở rộng...

Bài toán của bạn, tôi thấy lạ lạ! Giả sử, nếu một khách hàng mua nhiều lần và mỗi lần mua mỗi món hàng khác nhau, khi lọc không trùng, dĩ nhiên sẽ lấy tên khách hàng không trùng, nhưng mảng Ngay sẽ nhận giá trị là món hàng nào? Đầu tiên hay cuối cùng?

Xem file giả định để xem xét mảng Ngay cần nhận giá trị là gì!? - - -

quần áo trẻ em | quan ao tre em | quần áo sơ sinh | quần áo bé trai | quần áo bé gái | bodysuit carter | quan ao so sinh | quan ao tre em nhap khau
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Cá ngừ F1 đã viết:
E đang mần Code a Nghĩa mới khai triển... roẹt... 0.17s... tỉnh hết cả ngủ ạh
Nhấp chuột vào đây để mở rộng...
Với câu hỏi trong tin nhắn riêng, tôi nghĩ sẽ thực hiện trên 2 Dict, bởi mỗi Key của Dict chỉ có một Item duy nhất mà thôi nên chúng ta phải thêm 1 Dict khác để làm trung gian.

Tôi đưa lên đây để các cao thủ xem coi có cao kiến gì không, có thể bớt một Dict được không mà vẫn cải thiện được tốc độ từ bằng đến nhanh hơn.

Mã: 
Sub FindDate3Columns()


Dim t As Double
t = Timer
    
    Dim i As Long
    Dim MyRng As Range
    Dim Dict1 As Object, Dict2 As Object
    Dim Code, Ngay, Itm, Source, Source1, Source2, Source3
    
    With Sheet5
        Code = Range(.Range("T2"), .Range("T65536").End(xlUp))
    End With


    With Sheet9
        Set MyRng = Range(.Range("E2"), .Range("E65536").End(xlUp))
        Source = MyRng
        Source1 = MyRng.Offset(, 8)
        Source2 = MyRng.Offset(, 7)
        Source3 = MyRng.Offset(, 9)
    End With
    
    ReDim Ngay(1 To UBound(Code), 1 To 3)
    
    Set Dict1 = CreateObject("Scripting.Dictionary")
    Set Dict2 = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(Source)
        Itm = CStr(Source(i, 1))
        Dict1(Itm) = Source1(i, 1)
        Dict2(Itm) = i
    Next
    
    For i = 1 To UBound(Code)
        Itm = CStr(Code(i, 1))
        If Dict1.Exists(Itm) Then
            Ngay(i, 1) = Dict1(Itm)
            Ngay(i, 2) = Source2(Dict2(Itm), 1)
            Ngay(i, 3) = Source3(Dict2(Itm), 1)
        End If
    Next


    Sheet5.Range("Z2").Resize(UBound(Code), 3) = Ngay


MsgBox Timer - t


End Sub
 
Upvote 0
Mỗi kiểu code có cái hay riêng của nó. Nói chung nếu không hiểu rõ thì cứ mấy cái đơn giản mà mần tới, tốc độ có chậm chút cũng không sao.
Mình vẫn thích code theo kiểu ngắn nhất, gọn nhất, đơn giản nhất để những người mới học VBA tin rằng VBA không phức tạp
Nếu nói nạp dữ liệu với tốc độ cao thì mình có thấy cái System Collection Sortedlist nạp dữ liệu nhanh gấp 2 lần Dic, Object này cũng có 1 key và 1 value tương ứng, đặc biệt dữ liệu nạp vào luôn được sắp xếp tự động. Bạn nào hứng thú thì vọc cái dụng cụ này rồi mình cũng chia sẽ với nhau sự lợi hại của nó.
 
Upvote 0
Ếch Xanh đã viết:
Bài toán của bạn, tôi thấy lạ lạ! Giả sử, nếu một khách hàng mua nhiều lần và mỗi lần mua mỗi món hàng khác nhau, khi lọc không trùng, dĩ nhiên sẽ lấy tên khách hàng không trùng, nhưng mảng Ngay sẽ nhận giá trị là món hàng nào? Đầu tiên hay cuối cùng?

Xem file giả định để xem xét mảng Ngay cần nhận giá trị là gì!?+-+-+-+
Nhấp chuột vào đây để mở rộng...
E cảm ơn a...
Về việc bố trí sắp xếp cơ sở dữ liệu đều theo mã khách hàng.. mỗi khách hàng có thể có nhiều lần mua hàng.. từng lần mua lại có 1 mã mua duy nhất.. bên source thì bố trí theo từng mã mua duy nhất, đảm bảo yêu cầu ko bị trùng lặp ạh, do đó chỉ tìm bản ghi đầu tiên thôi ạh
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Với câu hỏi trong tin nhắn riêng, tôi nghĩ sẽ thực hiện trên 2 Dict, bởi mỗi Key của Dict chỉ có một Item duy nhất mà thôi nên chúng ta phải thêm 1 Dict khác để làm trung gian.

Tôi đưa lên đây để các cao thủ xem coi có cao kiến gì không, có thể bớt một Dict được không mà vẫn cải thiện được tốc độ từ bằng đến nhanh hơn.
Nhấp chuột vào đây để mở rộng...

Nếu cần lấy 3 cột thì vẫn chỉ 1 Dic mà thôi. Muốn chẻ Source1 thành 3 mảng thì chẻ, nhưng vì 3 cột liền nhau nên tôi dùng 1 mảng 3 cột.

PHP: 
Sub FindDate4()
Dim t As Double
t = Timer
    Dim i As Long
    Dim MyRng As Range
    Dim Dict1 As Object, Dict2 As Object
    Dim Code, Ngay, Itm, Source, Source1, Source2, Source3
    
With Sheet5
    Code = Range(.Range("T2"), .Range("T65536").End(xlUp))
End With
    With Sheet9
        Set MyRng = Range(.Range("E2"), .Range("E65536").End(xlUp))
        Source = MyRng
        Source1 = MyRng.Offset(, 7).Resize(, 3)
    End With
    
    ReDim Ngay(1 To UBound(Code), 1 To 3)
    
    Set Dict1 = CreateObject("Scripting.Dictionary")
    
        For i = 1 To UBound(Source)
            Itm = CStr(Source(i, 1))
            If Itm > "" And Not Dict1.Exists(Itm) Then
                Dict1.Add Itm, i
            End If
        Next
    
    For i = 1 To UBound(Code)
        Itm = CStr(Code(i, 1))
        If Dict1.Exists(Itm) Then
            Ngay(i, 1) = Source1(Dict1.Item(Itm), 2)
            Ngay(i, 2) = Source1(Dict1.Item(Itm), 1)
            Ngay(i, 3) = Source1(Dict1.Item(Itm), 3)
        End If
    Next


    Sheet5.Range("Z2").Resize(UBound(Code), 3) = Ngay

MsgBox Timer - t
End Sub
 
Upvote 0
quanghai1969 đã viết:
Mỗi kiểu code có cái hay riêng của nó. Nói chung nếu không hiểu rõ thì cứ mấy cái đơn giản mà mần tới, tốc độ có chậm chút cũng không sao.
Mình vẫn thích code theo kiểu ngắn nhất, gọn nhất, đơn giản nhất để những người mới học VBA tin rằng VBA không phức tạp
Nếu nói nạp dữ liệu với tốc độ cao thì mình có thấy cái System Collection Sortedlist nạp dữ liệu nhanh gấp 2 lần Dic, Object này cũng có 1 key và 1 value tương ứng, đặc biệt dữ liệu nạp vào luôn được sắp xếp tự động. Bạn nào hứng thú thì vọc cái dụng cụ này rồi mình cũng chia sẽ với nhau sự lợi hại của nó.
Nhấp chuột vào đây để mở rộng...
Chưa hấp thụ các kiến thức này..ma đầu e đang quay quay.. mắt cay cay.. người đau nhừ ạh.. hị hị +-+-+-+
 
Upvote 0
ptm0412 đã viết:
Nếu cần lấy 3 cột thì vẫn chỉ 1 Dic mà thôi. Muốn chẻ Source1 thành 3 mảng thì chẻ, nhưng vì 3 cột liền nhau nên tôi dùng 1 mảng 3 cột.

PHP: 
Sub FindDate4()
Dim t As Double
t = Timer
    Dim i As Long
    Dim MyRng As Range
    Dim Dict1 As Object, Dict2 As Object
    Dim Code, Ngay, Itm, Source, Source1, Source2, Source3
    
With Sheet5
    Code = Range(.Range("T2"), .Range("T65536").End(xlUp))
End With
    With Sheet9
        Set MyRng = Range(.Range("E2"), .Range("E65536").End(xlUp))
        Source = MyRng
        Source1 = MyRng.Offset(, 7).Resize(, 3)
    End With
    
    ReDim Ngay(1 To UBound(Code), 1 To 3)
    
    Set Dict1 = CreateObject("Scripting.Dictionary")
    
        For i = 1 To UBound(Source)
            Itm = CStr(Source(i, 1))
            If Itm > "" And Not Dict1.Exists(Itm) Then
                Dict1.Add Itm, i
            End If
        Next
    
    For i = 1 To UBound(Code)
        Itm = CStr(Code(i, 1))
        If Dict1.Exists(Itm) Then
            Ngay(i, 1) = Source1(Dict1.Item(Itm), 2)
            Ngay(i, 2) = Source1(Dict1.Item(Itm), 1)
            Ngay(i, 3) = Source1(Dict1.Item(Itm), 3)
        End If
    Next


    Sheet5.Range("Z2").Resize(UBound(Code), 3) = Ngay

MsgBox Timer - t
End Sub
Nhấp chuột vào đây để mở rộng...

Phát triển lên kiểu j về sau cũng có trường hợp các trường ngay bố trí ko liền nhau ạh
 
Lần chỉnh sửa cuối:
Upvote 0
Cá ngừ F1 đã viết:
Phát triển lên kiểu j về sau cũng có trường hợp các trường ngay bố trí ko liền nhau ạh
Nhấp chuột vào đây để mở rộng...
Thì tôi đã bảo chẻ mảng Source1 thành 3 mảng 1 cột như Nghĩa đã làm. Code vẫn y như vậy.

Mã: 
[COLOR=#000000][COLOR=#007700]For [/COLOR][COLOR=#0000BB]i [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000BB]1 To UBound[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]Code[/COLOR][COLOR=#007700])
        [/COLOR][COLOR=#0000BB]Itm [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000BB]CStr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]Code[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]i[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]1[/COLOR][COLOR=#007700]))
        If [/COLOR][COLOR=#0000BB]Dict1[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Exists[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]Itm[/COLOR][COLOR=#007700]) [/COLOR][COLOR=#0000BB]Then
            Ngay[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]i[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]1[/COLOR][COLOR=#007700]) = [/COLOR][COLOR=#0000BB]Source[/COLOR][/COLOR][COLOR=#ff0000]1[/COLOR][COLOR=#000000][COLOR=#0000BB][/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]Dict[/COLOR][/COLOR][COLOR=#ff0000]1[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Item[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]Itm[/COLOR][COLOR=#007700]), [/COLOR][COLOR=#ff0000]1[/COLOR][COLOR=#007700])
            [/COLOR][COLOR=#0000BB]Ngay[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]i[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]2[/COLOR][COLOR=#007700]) = [/COLOR][COLOR=#0000BB]Source[/COLOR][COLOR=#ff0000]2[/COLOR][COLOR=#0000BB][/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]Dict[/COLOR][COLOR=#ff0000]1[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Item[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]Itm[/COLOR][COLOR=#007700]), [/COLOR][COLOR=#ff0000]1[/COLOR][COLOR=#007700])
            [/COLOR][COLOR=#0000BB]Ngay[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]i[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]3[/COLOR][COLOR=#007700]) = [/COLOR][COLOR=#0000BB]Source[/COLOR][COLOR=#ff0000]3[/COLOR][COLOR=#0000BB][/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]Dict[/COLOR][COLOR=#ff0000]1[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Item[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]Itm[/COLOR][COLOR=#007700]), [/COLOR][COLOR=#ff0000]1[/COLOR][COLOR=#007700])
        [/COLOR][COLOR=#0000BB]End [/COLOR][COLOR=#007700]If
    [/COLOR][COLOR=#0000BB]Next[/COLOR]
 
Upvote 0
Kết hợp code của thầy PTM và a Nghĩa, e xin phép lái xe:
Mã: 
Sub FindDateLast()
Dim t As Double
t = Timer
    Dim i As Long
    Dim MyRng As Range
    Dim Dict1 As Object, Dict2 As Object
    Dim Code, Ngay, Itm, Source, Source1, Source2, Source3
With Sheet5
    Code = Range(.Range("T2"), .Range("T65536").End(xlUp))
End With
    With Sheet9
        Set MyRng = Range(.Range("E2"), .Range("E65536").End(xlUp))
        Source = MyRng
        Source1 = MyRng.Offset(, 8)
        Source2 = MyRng.Offset(, 7)
        Source3 = MyRng.Offset(, 9)
    End With
    ReDim Ngay(1 To UBound(Code), 1 To 3)
    Set Dict1 = CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Source)
            Itm = CStr(Source(i, 1))
            If Itm > "" And Not Dict1.Exists(Itm) Then
                Dict1.Add Itm, i
            End If
        Next
    For i = 1 To UBound(Code)
        Itm = CStr(Code(i, 1))
        If Dict1.Exists(Itm) Then
            Ngay(i, 1) = Source1(Dict1.Item(Itm), 1)
            Ngay(i, 2) = Source2(Dict1.Item(Itm), 1)
            Ngay(i, 3) = Source3(Dict1.Item(Itm), 1)
        End If
    Next
    Sheet5.Range("Z2").Resize(UBound(Code), 3) = Ngay
MsgBox Timer - t
End Sub
E cũng pốt file và các code của thầy PTM, a Hải, a Nghĩa để chia sẻ, ai gặp trường hợp tương tự cứ thế triển khai..
E xin cảm ơn!
 

File đính kèm

Upvote 0
Các code lấy ra kết quả 1 cột: Từ 0.06 đến 0.08 giây
Hai code lấy ra kết quả 3 cột: từ 0.09 đến 0.12 giây
 
Upvote 0
Cá ngừ F1 đã viết:
Kết hợp code của thầy PTM và a Nghĩa, e xin phép lái xe:
Mã: 
Sub FindDateLast()
Dim t As Double
t = Timer
    Dim i As Long
    Dim MyRng As Range
    Dim Dict1 As Object, Dict2 As Object
    Dim Code, Ngay, Itm, Source, Source1, Source2, Source3
With Sheet5
    Code = Range(.Range("T2"), .Range("T65536").End(xlUp))
End With
    With Sheet9
        Set MyRng = Range(.Range("E2"), .Range("E65536").End(xlUp))
        Source = MyRng
        Source1 = MyRng.Offset(, 8)
        Source2 = MyRng.Offset(, 7)
        Source3 = MyRng.Offset(, 9)
    End With
    ReDim Ngay(1 To UBound(Code), 1 To 3)
    Set Dict1 = CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Source)
            Itm = CStr(Source(i, 1))
            If Itm > "" And Not Dict1.Exists(Itm) Then
                Dict1.Add Itm, i
            End If
        Next
    For i = 1 To UBound(Code)
        Itm = CStr(Code(i, 1))
        If Dict1.Exists(Itm) Then
            Ngay(i, 1) = Source1(Dict1.Item(Itm), 1)
            Ngay(i, 2) = Source2(Dict1.Item(Itm), 1)
            Ngay(i, 3) = Source3(Dict1.Item(Itm), 1)
        End If
    Next
    Sheet5.Range("Z2").Resize(UBound(Code), 3) = Ngay
MsgBox Timer - t
End Sub
E cũng pốt file và các code của thầy PTM, a Hải, a Nghĩa để chia sẻ, ai gặp trường hợp tương tự cứ thế triển khai..
E xin cảm ơn!
Nhấp chuột vào đây để mở rộng...
Cho mỗi code chạy qua 10 lần thế này rồi so sánh tốc độ nha
PHP: 
Sub QuangHai()
Dim t As Double, x As Byte
t = Timer
For x = 1 To 10
    Dim i As Long, J As Long, Tem(), Source()
    Dim Dic As Object, Code(), Ngay(), C As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheet5
        Code = .Range(.Range("T2"), .Range("T65536").End(xlUp)).Value
    End With
    With Sheet9
        Source = .Range(.Range("E2"), .Range("E65536").End(3)).Value
        Tem = .Range("L2").Resize(UBound(Source), 3).Value
    End With
    ReDim Ngay(1 To UBound(Code), 1 To 3)
    For i = 1 To UBound(Source)
        Dic(CStr(Source(i, 1))) = i
    Next
    For i = 1 To UBound(Code)
        If Dic.Exists(CStr(Code(i, 1))) Then
            C = Dic.Item(CStr(Code(i, 1)))
            Ngay(i, 2) = Tem(C, 1)
            Ngay(i, 1) = Tem(C, 2)
            Ngay(i, 3) = Tem(C, 3)
        End If
    Next
    Sheet5.Range("Z2").Resize(UBound(Code), 3) = Ngay
Next
MsgBox Timer - t
End Sub
 
Upvote 0
quanghai1969 đã viết:
Cho mỗi code chạy qua 10 lần thế này rồi so sánh tốc độ nha
Nhấp chuột vào đây để mở rộng...
Nhìn code đã thấy nhanh hơn rồi, nhưng tôi vẫn thích xét exists trước khi gán vào Dict, nó an toàn. Ngoài ra có sự khác biệt là Dict lấy i làm item ở ngay lần gặp đầu tiên. Còn gán trực tiếp, nó sẽ lấy i làm item ở lần gặp cuối cùng.
 
Upvote 0
ptm0412 đã viết:
Nhìn code đã thấy nhanh hơn rồi, nhưng tôi vẫn thích xét exists trước khi gán vào Dict, nó an toàn. Ngoài ra có sự khác biệt là Dict lấy i làm item ở ngay lần gặp đầu tiên. Còn gán trực tiếp, nó sẽ lấy i làm item ở lần gặp cuối cùng.
Nhấp chuột vào đây để mở rộng...
Em thấy Source trong file không trùng nên làm gì có đầu tiên hay sau cùng.
 
Upvote 0
ptm0412 đã viết:
Nếu cần lấy 3 cột thì vẫn chỉ 1 Dic mà thôi. Muốn chẻ Source1 thành 3 mảng thì chẻ, nhưng vì 3 cột liền nhau nên tôi dùng 1 mảng 3 cột.

PHP: 
    ReDim Ngay(1 To UBound(Code), 1 To 3)
    
    Set Dict1 = CreateObject("Scripting.Dictionary")
    
        For i = 1 To UBound(Source)
            Itm = CStr(Source(i, 1))
            If Itm > "" And Not Dict1.Exists(Itm) Then
                Dict1.Add Itm, i
            End If
        Next
Nhấp chuột vào đây để mở rộng...

Đúng là em thật ngớ ngẩn, coi bóng đá riết rồi "mụ óc" rồi! hihihiihi.+-+-+-+
 
Upvote 0
quanghai1969 đã viết:
Em thấy Source trong file không trùng nên làm gì có đầu tiên hay sau cùng.
Nhấp chuột vào đây để mở rộng...
Mình đang nói về tổng quát. Sự thực là với dữ liệu nhiều khó có thể kiểm tra trùng hay không để ra quyết định dùng kiểu nào. Bằng mắt thì dĩ nhiên không thể, bằng công thức thì có khi chạy không nổi với vài chục ngàn dòng, bằng code thì có nghĩa là phải viết 1 đoạn code kiểm tra trùng, rồi mới viết 1 thủ tục khác để Dict.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

V
Gộp File Từng File Excel vào 1 File (2 người xem)
Trả lời
1
Đọc
75
ptm0412
ptm0412
V
Quản lý xuất nhập vật tư trong kho
Trả lời
8
Đọc
216
LOGANWover
L
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD (1 người xem)
    • Thích
Trả lời
25
Đọc
1K
HUONGHCKT
H
N
Tạo COM Add-In bằng Visual C++ (2 người xem)
    • Thích
Trả lời
11
Đọc
1K
Tuanba1992
Tuanba1992
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (8 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
425
Đọc
55K
Hoàng Tuấn 868
H
J
Xử lý các file Excel bị nặng sau nhiều năm sử dụng
Trả lời
19
Đọc
2K
Hà Tiềm
H
Nguyễn Duy Tuân
PHƯƠNG PHÁP TRÍCH XUẤT NGƯỢC BÁO CÁO - Drilldown và Add-in A-Tools
    • Thích
Trả lời
1
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
phuongnam366377
VbaTools – Bộ công cụ mở rộng cho VBA trong Excel
    • Thích
Trả lời
37
Đọc
978
YêuCN
Y
ptm0412
Hàm XLOOKUP: Có thể bạn chưa biết hết tính năng và ứng dụng
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
24
Đọc
15K
nguyen huu tai
N
H
Tổng hợp Công Nợ theo Công trình
Trả lời
47
Đọc
907
HangktGTN
H
queluatb
Tự động tăng số hóa đơn theo điều kiện (2 người xem)
Trả lời
3
Đọc
100
HieuCD
H
Sơn Cận
Mẫu theo dõi hoạt động đội xe vận tải (1 người xem)
Trả lời
0
Đọc
58
Sơn Cận
Sơn Cận
GPE-Trợ Lý
TALKSHOW 16 BẬT MÍ THỦ THUẬT GOOGLE SHEET: TỔNG HỢP DỮ LIỆU TỪ NHIỀU SHEET & FILE BĂNG IMPORTRANGE
Trả lời
0
Đọc
161
GPE-Trợ Lý
GPE-Trợ Lý
L
File Excel nặng chưa tìm được lý do ở đâu . Mong các bác hỗ trợ ! (1 người xem)
Trả lời
6
Đọc
321
huhumalu
H
D
Lỗi khi sử dụng Excel bị dính chuột trái ( chỉ dùng Excel mới bị )
Trả lời
14
Đọc
17K
SonXD85
S
thanhss
Tự động lấy dữ liệu từ các sheet khác đưa vào sheet tổng hợp khi chọn Ngày hoặc tháng hoặc năm
Trả lời
24
Đọc
679
thanhss
thanhss
D
nhờ các bác tạo giúp e một file ghi nhớ và nhắc ngày thu tiền ạ
    • Ngạc nhiên
    • Cười
Trả lời
0
Đọc
114
duongdaicb
D
B
Mình có làm đoạn code VBA trong file access mà cứ báo lỗi nhờ mọi người hướng dẫn
Trả lời
9
Đọc
319
baybley
B
L
  • Question Question
Gõ và chọn tên trong ComboBox hiển thị giá trị trong textbox
    • Cười
Trả lời
6
Đọc
266
huhumalu
H
H
Excel không lọc được toàn bộ dữ liệu
Trả lời
1
Đọc
158
yeudoi
yeudoi
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom