[Hỏi] Tìm giá trị trong nhiều bảng đưa vào 1 sheet

phanminhphuong · 26/2/14

[Hỏi] Dò tìm "dữ liệu khủng" 60,000 dòng- Tìm giá trị trong nhiều bảng đưa vào 1sheet

FILE Ở BÀI NÀY #1
YÊU CẦU CHUẨN + HÌNH MINH HOẠ BÀI 9

Chào các bạn

Mình có 1 file Data - dữ liệu để làm báo cáo. Dữ liệu rất nhiều lên đến gần 60,000 dòng.

Mình muốn dò tìm/ lấy dữ liệu đó sang Sheet report.
Tức là:
1) Sheet report đã có sẵn các Mã số ở cột B để dò tìm từ Sheet Data sang
2) Nếu tương ứng với từng ô ở cột B Sheet "Report" thì lấy kết quả 1,2,3,4,5,6,7 ở 03 bảng Sheet data sang (Mã nào không có kết quả tương ứng thì để trống) cột T => Z của Sheet "Report"
- Không dùng hàm Vlookup vì quá nặng (chạy chậm) - Đã thử
- Cũng như không thể dùng WorkSheetFunction trong VBA - Đã thử
- Mình nghĩ chỉ có thể dùng mảng

Bạn nào vui lòng hướng dẫn mình cách dùng mảng để từ mã số tại cột B Sheet Report tìm kiếm các giá trị KQ1 => KQ7 (tại Sheet Data) đưa sang Sheet Report

Xin cảm ơn

otonhot · 26/2/14

phanminhphuong đã viết:
Chào các bạn

Mình có 1 file Data - dữ liệu để làm báo cáo. Dữ liệu rất nhiều lên đến gần 60,000 dòng.

Mình muốn dò tìm/ lấy dữ liệu đó sang Sheet report.
Tức là:
1) Sheet report đã có sẵn các Mã số ở cột B để dò tìm từ Sheet Data sang
2) Nếu tương ứng với từng ô ở cột B Sheet "Report" thì lấy kết quả 1,2,3,4,5,6,7 ở 03 bảng Sheet data sang (Mã nào không có kết quả tương ứng thì để trống)
- Không dùng hàm Vlookup vì quá nặng (chạy chậm) - Đã thử
- Cũng như không thể dùng WorkSheetFunction trong VBA - Đã thử
- Mình nghĩ chỉ có thể dùng mảng

Bạn nào vui lòng hướng dẫn mình cách dùng mảng để từ mã số tại cột B Sheet Report tìm kiếm các giá trị KQ1 => KQ7 (tại Sheet Data) đưa sang Sheet Report

Xin cảm ơn

Viết thử theo kiểu thao tác trực tiếp với Range có dùng được không?

Mã:

Sub lookup()

Dim StartRow, EndRow As Long, i As Long
Dim Table1 As Range, Table2 As Range, Table3 As Range, Table4 As Range

StartRow = 4
EndRow = Sheet2.Range("B60000").End(xlUp).Row

With Sheet3
      Set Table2 = .Range("B5:F" & .Range("F60000").End(xlUp).Row)
      Set Table3 = .Range("H5:J" & .Range("J60000").End(xlUp).Row)
      Set Table4 = .Range("M5:N" & .Range("N60000").End(xlUp).Row)
End With

On Error Resume Next
For i = StartRow To EndRow
    With Application.WorksheetFunction
       Sheet2.Cells(i, 20) = .VLookup(Sheet2.Cells(i, 2), Table2, 2, False)
       Sheet2.Cells(i, 21) = .VLookup(Sheet2.Cells(i, 2), Table2, 3, False)
       Sheet2.Cells(i, 22) = .VLookup(Sheet2.Cells(i, 2), Table2, 4, False)
       Sheet2.Cells(i, 23) = .VLookup(Sheet2.Cells(i, 2), Table2, 5, False)
       Sheet2.Cells(i, 24) = .VLookup(Sheet2.Cells(i, 2), Table3, 2, False)
       Sheet2.Cells(i, 25) = .VLookup(Sheet2.Cells(i, 2), Table3, 3, False)
       Sheet2.Cells(i, 26) = .VLookup(Sheet2.Cells(i, 2), Table4, 2, False)
    End With
Next i

MsgBox "Done!"
End Sub

phanminhphuong · 26/2/14

otonhot đã viết:

Viết thử theo kiểu thao tác trực tiếp với Range có dùng được không?

Mã:

Sub lookup()

Dim StartRow, EndRow As Long, i As Long
Dim Table1 As Range, Table2 As Range, Table3 As Range, Table4 As Range

StartRow = 4
EndRow = Sheet2.Range("B60000").End(xlUp).Row

With Sheet3
      Set Table2 = .Range("B5:F" & .Range("F60000").End(xlUp).Row)
      Set Table3 = .Range("H5:J" & .Range("J60000").End(xlUp).Row)
      Set Table4 = .Range("M5:N" & .Range("N60000").End(xlUp).Row)
End With

On Error Resume Next
For i = StartRow To EndRow
    With Application.WorksheetFunction
       Sheet2.Cells(i, 20) = .VLookup(Sheet2.Cells(i, 2), Table2, 2, False)
       Sheet2.Cells(i, 21) = .VLookup(Sheet2.Cells(i, 2), Table2, 3, False)
       Sheet2.Cells(i, 22) = .VLookup(Sheet2.Cells(i, 2), Table2, 4, False)
       Sheet2.Cells(i, 23) = .VLookup(Sheet2.Cells(i, 2), Table2, 5, False)
       Sheet2.Cells(i, 24) = .VLookup(Sheet2.Cells(i, 2), Table3, 2, False)
       Sheet2.Cells(i, 25) = .VLookup(Sheet2.Cells(i, 2), Table3, 3, False)
       Sheet2.Cells(i, 26) = .VLookup(Sheet2.Cells(i, 2), Table4, 2, False)
    End With
Next i

MsgBox "Done!"
End Sub

Chạy Code của bạn bị treo máy 15 fut rồi. Không được đâu. Dữ liệu quá lớn không dùng phương pháp này để dò tìm được. Hướng dẫn mình tạo mảng/ duyệt mảng được không?

phucbugis · 26/2/14

phanminhphuong đã viết:
Chào các bạn

Mình có 1 file Data - dữ liệu để làm báo cáo. Dữ liệu rất nhiều lên đến gần 60,000 dòng.

Mình muốn dò tìm/ lấy dữ liệu đó sang Sheet report.
Tức là:
1) Sheet report đã có sẵn các Mã số ở cột B để dò tìm từ Sheet Data sang
2) Nếu tương ứng với từng ô ở cột B Sheet "Report" thì lấy kết quả 1,2,3,4,5,6,7 ở 03 bảng Sheet data sang (Mã nào không có kết quả tương ứng thì để trống) cột T => Z của Sheet "Report"
- Không dùng hàm Vlookup vì quá nặng (chạy chậm) - Đã thử
- Cũng như không thể dùng WorkSheetFunction trong VBA - Đã thử
- Mình nghĩ chỉ có thể dùng mảng

Bạn nào vui lòng hướng dẫn mình cách dùng mảng để từ mã số tại cột B Sheet Report tìm kiếm các giá trị KQ1 => KQ7 (tại Sheet Data) đưa sang Sheet Report

Xin cảm ơn

Nếu các No ko trùng nhau thì bạn có thể dùng Scripting.Dictionary

bạn mở file test thử, xem mình làm cách đó có ổn ko? --=0

(vào sheet Report - click Update)
link: https://www.mediafire.com/?nx3t63cxpd2kelv

phanminhphuong · 26/2/14

phucbugis đã viết:
Nếu các No ko trùng nhau thì bạn có thể dùng Scripting.Dictionary

bạn mở file test thử, xem mình làm cách đó có ổn ko?
(vào sheet Report - click Update)
link: https://www.mediafire.com/?nx3t63cxpd2kelv

Cảm ơn bạn đã trợ giúp nhưng không ổn
ở đoạn này:

Mã:

Sub copyData1()
    With Range([C1048576].End(xlUp), [F4])
        .Copy
        Range("T4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        .ClearContents
    End With
End Sub

Sub copyData2()
    With Range([C1048576].End(xlUp), [D4])
        .Copy
        Range("X4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        .ClearContents
    End With
End Sub

Sub copyData3()
    With Range([C1048576].End(xlUp), [C4])
        .Copy
        Range("Z4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        .ClearContents
    End With
End Sub

file ở bài 1 mình đưa lên ở vùng Sheet("Report").[C:F] không có dữ liệu nhưng thực tế là có dữ liệu
Đoạn code trên xoá hết dữ liệu. Tức là vẫn làm tạm trên Sheet rồi mới Paste Value sang Sheet("Report").[T:Z] là không ổn.
Và có phát sinh 1 tí yêu cầu nữa là mình muốn nhận được kết quả ở Sheet("Report") như hình.

* Các mã (Cột No.) không trùng nhau
* (Cột Kq1 tìm được bên Sheet Data là 3, KQ2 là 1, KQ3 là 4, KQ4 là 2, KQ5 là 5, KQ6 là 6, KQ7 là 7)

Mong mọi người giúp đỡ cách nào nhanh gọn nhất.
Xin cảm ơn

phucbugis · 26/2/14

phanminhphuong đã viết:
file ở bài 1 mình đưa lên ở vùng Sheet("Report").[C:F] không có dữ liệu nhưng thực tế là có dữ liệu
Đoạn code trên xoá hết dữ liệu. Tức là vẫn làm tạm trên Sheet rồi mới Paste Value sang Sheet("Report").[T:Z] là không ổn.

Cho mình hỏi, từ cột C-> cột S, số liệu của bạn có chứa bất kỳ công thức nào ko?

phanminhphuong · 26/2/14

phucbugis đã viết:
Cho mình hỏi, từ cột C-> cột S, số liệu của bạn có chứa bất kỳ công thức nào ko?

Từ Cột C->S của Sheet Report không có công thức, chỉ có dữ liệu.
Nếu được xin đừng can thiệp (thêm/ bớt cột ...) trên Sheet Report.

* Sheet Data cấu trúc không đổi như file bài 1
* Kết quả Sheet Report muốn lấy như hình bài 5
(* Các mã (Cột No.) không trùng nhau)

Mong các bạn trợ giúp dò tìm sao cho nhanh nhất

concogia · 26/2/14

Sử dụng mảng cho bài này hông khó, nhưng sao kết quả ra như bài 5 được nhỉ ??? Bạn giải thích rõ hơn xem sao chứ mình thấy hình như kết quả nó phải là 1, 2, 3, 4, 5, 6, 7 chứ, híc, rối "tung lò mò"
thân

phanminhphuong · 26/2/14

Kết quả như hình Minh Hoạ

concogia đã viết:
Sử dụng mảng cho bài này hông khó, nhưng sao kết quả ra như bài 5 được nhỉ ??? Bạn giải thích rõ hơn xem sao chứ mình thấy hình như kết quả nó phải là 1, 2, 3, 4, 5, 6, 7 chứ, híc, rối "tung lò mò"
thân

Như mình nói ở bài 7: (ĐÃ THÊM HÌNH MINH HOẠ)

1) Sheet Data cấu trúc không đổi như file bài 1

2) Kết quả Sheet Report muốn lấy như hình bên dưới, vì Form của Sheet Report như thế rồi (Sếp yêu cầu không thay đổi form):
* Tức là cột trên Sheet Report <=> Cột trên Sheet Data như sau:
KQ1 <=> Ketqua3
KQ2 <=> Ketqua1
KQ3 <=> Ketqua4
KQ4 <=> Ketqua2
KQ5 <=> Ketqua5
KQ6 <=> Ketqua6
KQ7 <=> Ketqua7

3) 02 form của 02 Sheet không được thay đổi

4) Các mã (Cột No.) không trùng nhau

Nếu bài của bạn phucbugis chỉ cần sửa đoạn này là được (nhưng khổ nỗi code lại copy/ paste value trên sheet report => Mất dữ liệu)

Mã:

Sub Bate1()
On Error Resume Next
Dim ArrDulieu1(), ArrKQ(), Dic, I As Long, J As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
ArrKQ = Range([B4], [B1048576].End(xlUp)).Resize(, 5).Value
With Sheets("Data")
    ArrDulieu1 = Range(.[B5], .[B1048576].End(xlUp)).Resize(, 5).Value
End With

    For I = 1 To UBound(ArrDulieu1, 1)
        Tem = ArrDulieu1(I, 1)
        If Not IsEmpty(Tem) And Not Dic.Exists(Tem) Then
            Dic.Add Tem, I
        End If
    Next I
    
    For I = 1 To UBound(ArrKQ, 1)
        Tem = ArrKQ(I, 1)
        If Dic.Exists(Tem) Then
            [COLOR=#ff0000]ArrKQ(I, 1) = ArrDulieu1(Dic.Item(Tem), 1)
            ArrKQ(I, 2) = ArrDulieu1(Dic.Item(Tem), 4)
            ArrKQ(I, 3) = ArrDulieu1(Dic.Item(Tem), 2)
            ArrKQ(I, 4) = ArrDulieu1(Dic.Item(Tem), 5)
            ArrKQ(I, 5) = ArrDulieu1(Dic.Item(Tem), 3)[/COLOR]
        End If
    Next I

[B4].Resize(UBound(ArrKQ, 1), 5) = ArrKQ
Set Dic = Nothing
Call copyData1 '[COLOR=#ff0000]=> Không dùng được[/COLOR]
End Sub
'================================================
Sub copyData1() 
    With Range([C1048576].End(xlUp), [F4]) '[COLOR=#ff0000]=> Không dùng được[/COLOR]
        .Copy
        Range("T4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        .ClearContents
    End With
End Sub

concogia · 26/2/14

Có thể là thế này, hông chắc trúng
Thân

Mã:

Public Sub ToTiTe()
    Dim DaTa1 As Variant, DaTa2 As Variant, DaTa3 As Variant, I As Long, J As Long, Mg As Variant, iMax As Long, d As Object, K As Long
    Dim Kq As Variant, Vung As Variant
    Set d = CreateObject("scripting.dictionary")
    DaTa1 = Sheets("Data").Range(Sheets("Data").[B5], Sheets("Data").[B100000].End(xlUp)).Resize(, 5)
    DaTa2 = Sheets("Data").Range(Sheets("Data").[H5], Sheets("Data").[H100000].End(xlUp)).Resize(, 3)
    DaTa3 = Sheets("Data").Range(Sheets("Data").[M5], Sheets("Data").[M100000].End(xlUp)).Resize(, 2)
    iMax = Application.WorksheetFunction.Max(UBound(DaTa1), UBound(DaTa2), UBound(DaTa3))
    ReDim Mg(1 To iMax, 1 To 7)
    For I = 1 To iMax
        If I <= UBound(DaTa1) Then
            If DaTa1(I, 1) <> "" Then
                If Not d.exists(DaTa1(I, 1)) Then
                    K = K + 1
                    d.Add DaTa1(I, 1), K
                    Mg(K, 1) = DaTa1(I, 4): Mg(K, 2) = DaTa1(I, 2): Mg(K, 3) = DaTa1(I, 5): Mg(K, 4) = DaTa1(I, 3)
                Else
                    Mg(d.Item(DaTa1(I, 1)), 1) = DaTa1(I, 4): Mg(d.Item(DaTa1(I, 1)), 2) = DaTa1(I, 2)
                    Mg(d.Item(DaTa1(I, 1)), 3) = DaTa1(I, 5): Mg(d.Item(DaTa1(I, 1)), 4) = DaTa1(I, 3)
                End If
            End If
        End If
            If I <= UBound(DaTa2) Then
                If DaTa2(I, 1) <> "" Then
                    If Not d.exists(DaTa2(I, 1)) Then
                        K = K + 1
                        d.Add DaTa2(I, 1), K
                        For J = 2 To 3
                            Mg(K, J + 3) = DaTa2(I, J)
                        Next J
                    Else
                        For J = 2 To 3
                            Mg(d.Item(DaTa2(I, 1)), J + 3) = DaTa2(I, J)
                        Next J
                    End If
                End If
           End If
                    If I <= UBound(DaTa3) Then
                        If DaTa3(I, 1) <> "" Then
                            If Not d.exists(DaTa3(I, 1)) Then
                                K = K + 1
                                d.Add DaTa3(I, 1), K
                                Mg(K, 7) = DaTa3(I, 2)
                            Else
                                Mg(d.Item(DaTa3(I, 1)), 7) = DaTa3(I, 2)
                            End If
                        End If
                    End If
    Next I
            Vung = Sheets("Report").Range(Sheets("Report").[B4], Sheets("Report").[B100000].End(xlUp))
            ReDim Kq(1 To UBound(Vung), 1 To 7)
            For I = 1 To UBound(Vung)
                 If d.exists(Vung(I, 1)) Then
                     For J = 1 To 7
                         Kq(I, J) = Mg(d.Item(Vung(I, 1)), J)
                     Next J
                 End If
            Next I
      Sheets("Report").[T4].Resize(UBound(Vung), 7) = Kq
End Sub

phanminhphuong · 26/2/14

concogia đã viết:

Có thể là thế này, hông chắc trúng
Thân

Mã:

Public Sub ToTiTe()
    Dim DaTa1 As Variant, DaTa2 As Variant, DaTa3 As Variant, I As Long, J As Long, Mg As Variant, iMax As Long, d As Object, K As Long
    Dim Kq As Variant, Vung As Variant
    Set d = CreateObject("scripting.dictionary")
    DaTa1 = Sheets("Data").Range(Sheets("Data").[B5], Sheets("Data").[B100000].End(xlUp)).Resize(, 5)
    DaTa2 = Sheets("Data").Range(Sheets("Data").[H5], Sheets("Data").[H100000].End(xlUp)).Resize(, 3)
    DaTa3 = Sheets("Data").Range(Sheets("Data").[M5], Sheets("Data").[M100000].End(xlUp)).Resize(, 2)
    iMax = Application.WorksheetFunction.Max(UBound(DaTa1), UBound(DaTa2), UBound(DaTa3))
    ReDim Mg(1 To iMax, 1 To 7)
    For I = 1 To iMax
        If I <= UBound(DaTa1) Then
            If DaTa1(I, 1) <> "" Then
                If Not d.exists(DaTa1(I, 1)) Then
                    K = K + 1
                    d.Add DaTa1(I, 1), K
                    Mg(K, 1) = DaTa1(I, 4): Mg(K, 2) = DaTa1(I, 2): Mg(K, 3) = DaTa1(I, 5): Mg(K, 4) = DaTa1(I, 3)
                Else
                    Mg(d.Item(DaTa1(I, 1)), 1) = DaTa1(I, 4): Mg(d.Item(DaTa1(I, 1)), 2) = DaTa1(I, 2)
                    Mg(d.Item(DaTa1(I, 1)), 3) = DaTa1(I, 5): Mg(d.Item(DaTa1(I, 1)), 4) = DaTa1(I, 3)
                End If
            End If
        End If
            If I <= UBound(DaTa2) Then
                If DaTa2(I, 1) <> "" Then
                    If Not d.exists(DaTa2(I, 1)) Then
                        K = K + 1
                        d.Add DaTa2(I, 1), K
                        For J = 2 To 3
                            Mg(K, J + 3) = DaTa2(I, J)
                        Next J
                    Else
                        For J = 2 To 3
                            Mg(d.Item(DaTa2(I, 1)), J + 3) = DaTa2(I, J)
                        Next J
                    End If
                End If
           End If
                    If I <= UBound(DaTa3) Then
                        If DaTa3(I, 1) <> "" Then
                            If Not d.exists(DaTa3(I, 1)) Then
                                K = K + 1
                                d.Add DaTa3(I, 1), K
                                Mg(K, 7) = DaTa3(I, 2)
                            Else
                                Mg(d.Item(DaTa3(I, 1)), 7) = DaTa3(I, 2)
                            End If
                        End If
                    End If
    Next I
            Vung = Sheets("Report").Range(Sheets("Report").[B4], Sheets("Report").[B100000].End(xlUp))
            ReDim Kq(1 To UBound(Vung), 1 To 7)
            For I = 1 To UBound(Vung)
                 If d.exists(Vung(I, 1)) Then
                     For J = 1 To 7
                         Kq(I, J) = Mg(d.Item(Vung(I, 1)), J)
                     Next J
                 End If
            Next I
      Sheets("Report").[T4].Resize(UBound(Vung), 7) = Kq
End Sub

Chạy ngon lành. Cảm ơn bạn. Mai phải ngồi nghiên cứu tiếp code của bạn.
Thanks again

otonhot · 27/2/14

concogia đã viết:

Có thể là thế này, hông chắc trúng
Thân

Mã:

Public Sub ToTiTe()
    Dim DaTa1 As Variant, DaTa2 As Variant, DaTa3 As Variant, I As Long, J As Long, Mg As Variant, iMax As Long, d As Object, K As Long
    Dim Kq As Variant, Vung As Variant
    Set d = CreateObject("scripting.dictionary")
    DaTa1 = Sheets("Data").Range(Sheets("Data").[B5], Sheets("Data").[B100000].End(xlUp)).Resize(, 5)
    DaTa2 = Sheets("Data").Range(Sheets("Data").[H5], Sheets("Data").[H100000].End(xlUp)).Resize(, 3)
    DaTa3 = Sheets("Data").Range(Sheets("Data").[M5], Sheets("Data").[M100000].End(xlUp)).Resize(, 2)
    iMax = Application.WorksheetFunction.Max(UBound(DaTa1), UBound(DaTa2), UBound(DaTa3))
    ReDim Mg(1 To iMax, 1 To 7)
    For I = 1 To iMax
        If I <= UBound(DaTa1) Then
            If DaTa1(I, 1) <> "" Then
                If Not d.exists(DaTa1(I, 1)) Then
                    K = K + 1
                    d.Add DaTa1(I, 1), K
                    Mg(K, 1) = DaTa1(I, 4): Mg(K, 2) = DaTa1(I, 2): Mg(K, 3) = DaTa1(I, 5): Mg(K, 4) = DaTa1(I, 3)
                Else
                    Mg(d.Item(DaTa1(I, 1)), 1) = DaTa1(I, 4): Mg(d.Item(DaTa1(I, 1)), 2) = DaTa1(I, 2)
                    Mg(d.Item(DaTa1(I, 1)), 3) = DaTa1(I, 5): Mg(d.Item(DaTa1(I, 1)), 4) = DaTa1(I, 3)
                End If
            End If
        End If
            If I <= UBound(DaTa2) Then
                If DaTa2(I, 1) <> "" Then
                    If Not d.exists(DaTa2(I, 1)) Then
                        K = K + 1
                        d.Add DaTa2(I, 1), K
                        For J = 2 To 3
                            Mg(K, J + 3) = DaTa2(I, J)
                        Next J
                    Else
                        For J = 2 To 3
                            Mg(d.Item(DaTa2(I, 1)), J + 3) = DaTa2(I, J)
                        Next J
                    End If
                End If
           End If
                    If I <= UBound(DaTa3) Then
                        If DaTa3(I, 1) <> "" Then
                            If Not d.exists(DaTa3(I, 1)) Then
                                K = K + 1
                                d.Add DaTa3(I, 1), K
                                Mg(K, 7) = DaTa3(I, 2)
                            Else
                                Mg(d.Item(DaTa3(I, 1)), 7) = DaTa3(I, 2)
                            End If
                        End If
                    End If
    Next I
            Vung = Sheets("Report").Range(Sheets("Report").[B4], Sheets("Report").[B100000].End(xlUp))
            ReDim Kq(1 To UBound(Vung), 1 To 7)
            For I = 1 To UBound(Vung)
                 If d.exists(Vung(I, 1)) Then
                     For J = 1 To 7
                         Kq(I, J) = Mg(d.Item(Vung(I, 1)), J)
                     Next J
                 End If
            Next I
      Sheets("Report").[T4].Resize(UBound(Vung), 7) = Kq
End Sub

Áp dụng Code đo thời gian của Nguyễn Duy Tuân vào thấy Code chạy kinh thật. Có 1665.78ms. Chớp mắt là xong. Không biết đến bao giờ mình mới đạt được mức này. Hic Hic Hic

Mã:

Option Explicit

Declare Function QueryPerformanceCounter Lib "Kernel32" _
                        (x As Currency) As Boolean
Declare Function QueryPerformanceFrequency Lib "Kernel32" _
                        (x As Currency) As Boolean

Sub DoThoiGian()
     
    Dim T1@, T2@, Freq@, Overhead@
    QueryPerformanceFrequency Freq
    QueryPerformanceCounter T1
    QueryPerformanceCounter T2
    Overhead = T2 - T1
    QueryPerformanceCounter T1
    
 
    ToTiTe 'Thu tuc ban  phai lam
    
    'Ket thuc chay thu tuc, nhan thoi gian ket thuc
    QueryPerformanceCounter T2
    'Debug.Print (T2 - T1 - Overhead) / Freq * 1000; "milliseconds(ms)"
    
    MsgBox "milliseconds(ms): " & (T2 - T1 - Overhead) / Freq * 1000
End Sub

otonhot · 27/2/14

Bài này nếu không dùng Dictionary / Collection thì có giải pháp nào khác không vậy? Dùng mảng đơn thuần thì hướng như thế nào? Xin được hướng dẫn.

[Hỏi] Tìm giá trị trong nhiều bảng đưa vào 1 sheet

phanminhphuong

Thành viên hoạt động

File đính kèm

otonhot

Thành viên mới

phanminhphuong

Thành viên hoạt động

phucbugis

Thành viên tích cực

phanminhphuong

Thành viên hoạt động

File đính kèm

phucbugis

Thành viên tích cực

phanminhphuong

Thành viên hoạt động

concogia

Gội rồi mới Cạo

phanminhphuong

Thành viên hoạt động

File đính kèm

concogia

Gội rồi mới Cạo

File đính kèm

phanminhphuong

Thành viên hoạt động

otonhot

Thành viên mới

otonhot

Thành viên mới

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

Facebook

Group

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