Các câu hỏi về mảng trong VBA (Array)

[viehoai]

Xin các anh chị giúp đỡ Code Gán các giá trị của một Range là các phần tử của Mãng
Ví dụ: Tôi có các giá trị của Range("A1:A10"). Tôi muốn viết code để gán giá trị của các cells từ A1:A10 là các phần tử của Mãng Arr chẳn hạn.
Xin cảm ơn các anh chị

 

[trungvdb]

Dictionary lọc duy nhất có lấy được dòng cuối cùng (trong TH nhiều dòng bằng nhau)?

Tôi dùng Dictionary, dữ liệu đầu vào là cột A, B, dữ liệu đầu ra sau khi chạy Code được kết quả là cột D, E như hình dưới.

Sub Loc()
Dim DL, KQ, i As Long, j As Long, dongcuoi
Set Dic = CreateObject("Scripting.Dictionary")
dongcuoi = [A65000].End(xlUp).Row
DL = Range("A1:B" & dongcuoi).Value
ReDim KQ(1 To UBound(DL, 1), 1 To 2)
For i = 1 To UBound(DL, 1)
If DL(i, 1) <> "" And Not Dic.Exists(DL(i, 1)) Then
        j = j + 1
        Dic.Add DL(i, 1), j
        KQ(j, 1) = DL(i, 1)
        KQ(j, 2) = DL(i, 2)
    End If
Next
If j > 0 Then [D1].Resize(j, 2).Value = KQ
End Sub

Theo mặc định nếu cột A có từ 2 giá trị giống nhau trở lên thì Dic sẽ đưa dòng đầu tiên vào Dic.Add key, Item. Ví dụ ứng với cột A, ngày 2-1-2012 có hai dòng 4,5 bằng nhau thì Dic sẽ lấy dòng 4 cho sang vùng kết quả.

Tuy vậy, do yêu cầu công việc tôi muốn key nạp vào Dic sẽ lấy ô cuối cùng trong số các ô bằng nhau (cụ thể ở bài toán này, ví dụ kết quả E3 trên hình theo yêu cầu đặt ra là 135 thay vì mặc định là 130) thì phải làm thế nào? Liệu Dictionary có giải quyết được TH này không, hay là phải chuyển sang làm kiểu khác.

 

[ndu96081631]

Theo mặc định nếu cột A có từ 2 giá trị giống nhau trở lên thì Dic sẽ đưa dòng đầu tiên vào Dic.Add key, Item. Ví dụ ứng với cột A, ngày 2-1-2012 có hai dòng 4,5 bằng nhau thì Dic sẽ lấy dòng 4 cho sang vùng kết quả.

Tuy vậy, do yêu cầu công việc tôi muốn key nạp vào Dic sẽ lấy ô cuối cùng trong số các ô bằng nhau (cụ thể ở bài toán này, ví dụ kết quả E3 trên hình theo yêu cầu đặt ra là 135 thay vì mặc định là 130) trong số các ô bằng nhau thì phải làm thế nào? Liệu Dictionary có giải quyết được TH này không, hay là phải chuyển sang làm kiểu khác.

Đây là lúc mà bạn thấy Item phát huy tác dụng... Ta sẽ dùng Item để đánh dấu vị trí của mảng KQ thông qua giá trị j

Sub Loc()
  Dim DL, KQ, i As Long, j As Long, Dic As Object, tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  DL = Range([A1], [A65000].End(xlUp)).Resize(, 2).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 2)
  For i = 1 To UBound(DL, 1)
    If DL(i, 1) <> "" Then
      tmp = DL(i, 1)
      If Not Dic.Exists(tmp) Then
        j = j + 1
        Dic.Add DL(i, 1), j
        KQ(j, 1) = DL(i, 1)
        KQ(j, 2) = DL(i, 2)
      Else
        KQ(Dic.Item(tmp), 2) = DL(i, 2)
      End If
    End If
  Next
  If j Then Range("D1").Resize(j, 2).Value = KQ
End Sub

 

[ThuNghi]

Đây là lúc mà bạn thấy Item phát huy tác dụng... Ta sẽ dùng Item để đánh dấu vị trí của mảng KQ thông qua giá trị j

Sub Loc()
  Dim DL, KQ, i As Long, j As Long, Dic As Object, tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  DL = Range([A1], [A65000].End(xlUp)).Resize(, 2).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 2)
  For i = 1 To UBound(DL, 1)
    If DL(i, 1) <> "" Then
      tmp = DL(i, 1)
      If Not Dic.Exists(tmp) Then
        j = j + 1
        Dic.Add DL(i, 1), j
        KQ(j, 1) = DL(i, 1)
        KQ(j, 2) = DL(i, 2)
      Else
        KQ(Dic.Item(tmp), 2) = DL(i, 2)
      End If
    End If
  Next
  If j Then Range("D1").Resize(j, 2).Value = KQ
End Sub

Hình như hơi dư dòng

KQ(j, 2) = DL(i, 2)
      Else

Sao kg add vào KQ như sau, đàng nào cũng phải add dòng cuối.

Sub Loc2()
  Dim DL, KQ, i As Long, j As Long, Dic As Object, tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  DL = Range([A1], [A65000].End(xlUp)).Resize(, 2).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 2)
  For i = 1 To UBound(DL, 1)
    If DL(i, 1) <> "" Then
      tmp = DL(i, 1)
      If Not Dic.Exists(tmp) Then
        j = j + 1
        Dic.Add tmp, j
        KQ(j, 1) = tmp
      End If
      KQ(Dic.Item(tmp), 2) = DL(i, 2)
    End If
  Next
  If j Then Range("D1").Resize(j, 2).Value = KQ
End Sub

 

[ndu96081631]

Hình như hơi dư dòng

KQ(j, 2) = DL(i, 2)
      Else

Sao kg add vào KQ như sau, đàng nào cũng phải add dòng cuối.

Sub Loc2()
  Dim DL, KQ, i As Long, j As Long, Dic As Object, tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  DL = Range([A1], [A65000].End(xlUp)).Resize(, 2).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 2)
  For i = 1 To UBound(DL, 1)
    If DL(i, 1) <> "" Then
      tmp = DL(i, 1)
      If Not Dic.Exists(tmp) Then
        j = j + 1
        Dic.Add tmp, j
        KQ(j, 1) = tmp
      End If
      KQ(Dic.Item(tmp), 2) = DL(i, 2)
    End If
  Next
  If j Then Range("D1").Resize(j, 2).Value = KQ
End Sub

Bạn trungvdb đang thắc mắc về cách áp dụng Item ấy mà... nên cho 1 ví dụ thôi

 

[trungvdb]

Tôi có thắc mắc: Trong quá trình nạp vào Dic, nó kiểm tra trường hợp giá trị đó đã có trong thư viện (keys) của Dic rồi thì nó có đâu có được nạp vào (tức là không được Dic đánh dấu dòng đó) thì làm sao mà sinh ra Item của dòng đó được nhỉ, như vậy làm gì có cơ sở để thực hiện dòng KQ(Dic.Item(tmp), 2) = DL(i, 2)?

 

[ndu96081631]

Nhưng Dic nó kiểm tra trường hợp giá trị đó đã có trong thư viện (keys) của Dic rồi thì nó có đâu có được nạp vào (tức là không được Dic đánh dấu dòng đó) thì làm sao mà sinh ra Item của dòng đó được nhỉ?

Quá trình hoạt động như sau:
- Kiểm tra xem có tồn tại trong Dic hay không? Nếu không tồn tại, nạp 1 cặp gồm Key và Item (trong đó Item chính là biến j trong bài của bạn và nó cũng là vị trí dòng thứ j trong mảng KQ)
- Ngược lại (là Else ấy), tức có tồn tại rồi thì tra Key (là biến tmp) để lấy ra giá trị j ---> Từ đó thay đổi giá trị thứ j trong mảng KQ
Thế thôi
Nói thêm: Dic.Item(tmp) là tìm xem cái "thằng" Key tmp ấy đang chứa Item nào! Nó gần giống như hàm VLOOKUP với trị tìm là tmp, bảng tra là Dictionary, kết quả tìm nằm ở Items

 

[trungvdb]

Cái này quả là tôi chưa biết. Tôi hiểu thế này không biết có đúng không:

Trong quá trình Dic đi dò cột A để thêm vào key của nó, nếu giá trị đó đã có rồi thì thực chất dòng đó vẫn có Item, chỉ có điều Item này không nạp vào Dic (Dic.Add tmp, j)

Có nghĩa là KQ(Dic.Item(tmp), 2) = DL(i, 2) bao hàm rộng hơn là KQ(j, 2) = DL(i, 2). Nó chỉ bằng nhau trong lần đầu tiên thôi

(nói cách khác là nếu trong trường hợp đã có rồi thì chỉ có khái niệm Dic.Item(tmp) mà không tồn tại j?)

 

[ndu96081631]

Cái này quả là tôi chưa biết. Tôi hiểu thế này không biết có đúng không:

Trong quá trình Dic đi dò cột A để thêm vào key của nó, nếu giá trị đó đã có rồi thì thực chất dòng đó vẫn có Item, chỉ có điều Item này không nạp vào Dic (Dic.Add tmp, j)

Có nghĩa là KQ(Dic.Item(tmp), 2) = DL(i, 2) bao hàm rộng hơn là KQ(j, 2) = DL(i, 2). Nó chỉ bằng nhau trong lần đầu tiên thôi

(nói cách khác là nếu trong trường hợp đã có rồi thì chỉ có khái niệm Dic.Item(tmp) mà không tồn tại j?)

Ở bài toán của bạn:
- Khi ta Add cặp Key, Item vào Dictionary, ta "cố tình" gán Item chính là vị trí của mảng KQ ---> Mục đích để lần sau biết đường mà tìm
- Lần đầu vòng lập, do Key chưa tồn tại nên được gán vào dòng thứ nhất của bảng tra... Trong đó Key đầu tiên sẽ = 01-01-2012 và Item sẽ =1
- Lần thứ 2 của vòng lập, ta thấy Key đã tồn tại, ta sẽ dùng chính Key này để tra ra Item (chính là giá trị j) ---> Từ đó gán giá trị DL(i,2) vào vị trí cột 2, dòng j của mảng KQ... Tại thời điểm này thì Dic.Item(tmp) sẽ = 1 ==> KQ(Dic.Item(tmp), 2) sẽ = KQ(1 , 2)
- Tường tự thế cho các lần lập thứ 3 trở đi
------------
Nói tóm lại:
- Hãy tưởng tượng Dictionary là 1 bảng tra 2 cột nhiều dòng, với cột 1 = Keys và cột 2 = Items
- Cột 1 luôn là các phần tử duy nhất và bắt buộc phải có
- Cột 2 là bất cứ giá trị nào và cũng không bắt buộc phải có
- Để tra 1 Item nào đó ta phải thông qua Key tương ứng của nó bằng lệnh Dic.Item(Key)
- Việc tra này tương đương với cách dùng VLOOKUP trong bảng tính

 

[trungvdb]

Cảm ơn thày, nhờ thày giảng tôi đã hoàn toàn hiểu rồi, hóa ra trước tôi hiểu sai vấn đề về Dic.Item(tmp) . Về bản chất j= Dic.Item(tmp)
(2 thằng này thực chất là 1 thằng, j chẳng qua là viết tắt thay cho Dic.Item(tmp)

Nguyên nhân có 2 kết quả khác nhau là do vị trí đặt KQ(j, 2) = DL(i, 2) trước End If hay sau End If quyết định. Sở dĩ giá trị cột E thay đổi là do DL(i,2) nó đã được chuyển từ ô trước xuống ô sau (do i tăng lên 1 đơn vị khi chuyển sang vòng lặp kế tiếp).

* Code này nó sẽ lấy giá trị cột B cuối cùng:

Sub Loc()
  Dim DL, KQ, i As Long, j As Long, Dic As Object, tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  DL = Range([A1], [A65000].End(xlUp)).Resize(, 2).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 2)
  For i = 1 To UBound(DL, 1)
    If DL(i, 1) <> "" Then
      tmp = DL(i, 1)
      If Not Dic.Exists(tmp) Then
        j = j + 1
        Dic.Add tmp, j
        KQ(j, 1) = tmp
      End If
      KQ(j, 2) = DL(i, 2)
    End If
  Next
  If j Then Range("D1").Resize(j, 2).Value = KQ
End Sub

* Nếu chỉ cần thay đổi dòng KQ(j, 2) = DL(i, 2) về trước End If thì nó lấy giá trị cột B dòng đầu tiên

Sub Loc()
  Dim DL, KQ, i As Long, j As Long, Dic As Object, tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  DL = Range([A1], [A65000].End(xlUp)).Resize(, 2).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 2)
  For i = 1 To UBound(DL, 1)
    If DL(i, 1) <> "" Then
      tmp = DL(i, 1)
      If Not Dic.Exists(tmp) Then
        j = j + 1
        Dic.Add tmp, j
        KQ(j, 1) = tmp
       KQ(j, 2) = DL(i, 2)
      End If
     End If
  Next
  If j Then Range("D1").Resize(j, 2).Value = KQ
End Sub

 

[ndu96081631]

Cảm ơn thày, nhờ thày giảng tôi đã hoàn toàn hiểu rồi, hóa ra trước tôi hiểu sai vấn đề về Dic.Item(tmp) . Về bản chất j= Dic.Item(tmp)
(2 thằng này thực chất là 1 thằng, j chẳng qua là viết tắt thay cho Dic.Item(tmp)

Mời bạn xem thêm bài trích lọc và tổng hợp theo điều kiện (có cộng dồn) tại đây để thấy vai trò của Item trong việc đánh dấu vị trí:
http://www.giaiphapexcel.com/forum/...-báo-cáo-từ-ngày-đến-ngày&p=375970#post375970

 

[nmhung49]

Mình có 1 bài tập này mong các bạn iu thích về mảng tham gia giải đáp Mình có 2 cột 1 cột sản phẩm 1 cột code khách hàng bây giờ mình muốn đếm sản phẩm đó tương ứng với khách hàng đó mua bao nhiêu lần rồi cho ra kết quả ở cột G2 --> K2 v..v.. Cái này dùng Pivot thì OK
Anh Ndu tham gia sau cùng nhen

 

[ThuNghi]

Mình có 1 bài tập này mong các bạn iu thích về mảng tham gia giải đáp Mình có 2 cột 1 cột sản phẩm 1 cột code khách hàng bây giờ mình muốn đếm sản phẩm đó tương ứng với khách hàng đó mua bao nhiêu lần rồi cho ra kết quả ở cột G2 --> K2 v..v.. Cái này dùng Pivot thì OK
Anh Ndu tham gia sau cùng nhen

Bài này NDU đã làm 1 code rất tổng quát về sum, max, min ...
Nhưng đang đang buồn làm thử lại xem.

Sub TaoBC()
Dim endR&, i&, iR&, iC&, nR&, nC&
Dim Arr, ArrKQ
Dim Tmp01$, Tmp02$
Dim Dic01 As Object, Dic02 As Object
Set Dic01 = CreateObject("Scripting.Dictionary")
Set Dic02 = CreateObject("Scripting.Dictionary")
With Sheets("Data")
  .AutoFilterMode = False
  endR = .Cells(65000, 1).End(3).Row
  Arr = .Range(.Cells(2, 1), .Cells(endR, 2)).Value
End With
ReDim ArrKQ(1 To UBound(Arr), 1 To UBound(Arr))
iR = 1: iC = 1
For i = 1 To UBound(Arr)
  If Len(CStr(Arr(i, 1))) > 0 And Len(CStr(Arr(i, 2))) > 0 Then
    Tmp01 = CStr(Arr(i, 2))
    If Not Dic01.Exists(Tmp01) Then
      iR = iR + 1
      Dic01.Add Tmp01, iR
      ArrKQ(iR, 1) = Tmp01
    End If
    Tmp02 = Arr(i, 1)
    If Not Dic02.Exists(Tmp02) Then
      iC = iC + 1
      Dic02.Add Tmp02, iC
      ArrKQ(1, iC) = Tmp02
    End If
    nR = Dic01.Item(Tmp01)
    nC = Dic02.Item(Tmp02)
    ArrKQ(nR, nC) = ArrKQ(nR, nC) + 1
  End If
Next i
If iR And iC Then
  With Sheets("sheet2")
    .Cells.ClearContents
    .[A1].Resize(iR, iC) = ArrKQ
  End With
End If
Erase Arr, ArrKQ
Set Dic01 = Nothing: Set Dic02 = Nothing
End Sub

Hùng kiểm tra lại nhé.

 

[nmhung49]

Bài này NDU đã làm 1 code rất tổng quát về sum, max, min ...
Nhưng đang đang buồn làm thử lại xem.
Hùng kiểm tra lại nhé.

Dạ hoàn toàn chính xác nhưng anh có thể nâng cấp lên dùng 1 Dic được không, em nghĩ dùng 1 Dic code sẽ gắn và tốc độ cũng tăng lên đáng kể. Thanks anh đã tham gia

 

[concogia]

Dạ hoàn toàn chính xác nhưng anh có thể nâng cấp lên dùng 1 Dic được không, em nghĩ dùng 1 Dic code sẽ gắn và tốc độ cũng tăng lên đáng kể. Thanks anh đã tham gia

Một cách làm ....một "Dít" đây, còn tốc độ thì....cóc biết vì có một nhúm dữ liệu hè.

Public Sub MotDit()
    Dim Vung, d, I, J, Tach, Mg(), K, kK, A, aA, iDong, iCot
    Set d = CreateObject("scripting.dictionary")
    Vung = Range([A2], [A100000].End(xlUp)).Resize(, 2).Value
    K = 1: kK = 1
        For J = 1 To UBound(Vung, 2)
            For I = 1 To UBound(Vung, 1)
                If Not d.exists(Vung(I, J)) Then
                        If J = 1 Then
                            K = K + 1
                            d.Add Vung(I, J), 1 & " " & K & " " & K
                        Else
                            kK = kK + 1
                            d.Add Vung(I, J), kK & " " & 1 & " " & kK
                        End If
                End If
            Next I
        Next J
            ReDim Mg(1 To d.Count, 1 To d.Count)
            A = d.items: aA = d.keys
            For I = 0 To d.Count - 1
                Tach = Split(A(I))
                Mg(Tach(0), Tach(1)) = aA(I)
            Next I
                For I = 1 To UBound(Vung)
                    iDong = Split(d.Item(Vung(I, 2)))
                    iCot = Split(d.Item(Vung(I, 1)))
                    Mg(iDong(2), iCot(2)) = Mg(iDong(2), iCot(2)) + 1
                Next I
    Range([f1], [XX1].End(xlToLeft)).Resize(100000).ClearContents
    [f1].Resize(UBound(Mg, 1), UBound(Mg, 2)) = Mg
End Sub

 

[nmhung49]

Một cách làm ....một "Dít" đây, còn tốc độ thì....cóc biết vì có một nhúm dữ liệu hè.

Bác Cò già vẫn phong độ như ngày xưa, em đã test thử dùng 1 Dic với 2 Dic thì thấy tốc độ 2 Dic cao hơn với dữ liệu nhiều. Cảm ơn anh ThuNghi và Chú Còn già đã giúp đỡ. Đoạn code của em cũng giống anh ThuNghi thôi...

Sub Tonghop()
    Dim VDL As Variant, KQ() As Variant, I As Long, N As Long, J As Long
    Dim Dic As Object, T As Double
    T = Timer
    Set Dic = CreateObject("Scripting.Dictionary")
    VDL = Range("a2:b46").Value
    ReDim KQ(1 To UBound(VDL, 1), 1 To 7)
    N = 1: J = 1
    With CreateObject("Scripting.Dictionary")
        For I = 1 To UBound(VDL, 1)
            If Not .Exists(VDL(I, 2)) Then
                N = N + 1
                KQ(N, 1) = VDL(I, 2)
                .Item(VDL(I, 2)) = N
            End If
            If Not Dic.Exists(VDL(I, 1)) Then
                J = J + 1
                Dic(VDL(I, 1)) = J
                KQ(1, J) = VDL(I, 1)
            End If
            KQ(.Item(VDL(I, 2)), Dic(VDL(I, 1))) = KQ(.Item(VDL(I, 2)), Dic(VDL(I, 1))) + 1
        
        Next
    End With
   
    With Range("R1")
        .CurrentRegion.ClearContents
        .Resize(N, J).Value = KQ
    End With
    Set Dic = Nothing
    Range("C3").Value = Timer - T
End Sub

 

[ndu96081631]

Bác Cò già vẫn phong độ như ngày xưa, em đã test thử dùng 1 Dic với 2 Dic thì thấy tốc độ 2 Dic cao hơn với dữ liệu nhiều. Cảm ơn anh ThuNghi và Chú Còn già đã giúp đỡ. Đoạn code của em cũng giống anh ThuNghi thôi...

Sub Tonghop()
    Dim VDL As Variant, KQ() As Variant, I As Long, N As Long, J As Long
    Dim Dic As Object, T As Double
    T = Timer
    Set Dic = CreateObject("Scripting.Dictionary")
    VDL = Range("a2:b46").Value
    ReDim KQ(1 To UBound(VDL, 1), 1 To 7)
    ''.....................

2 Dic cũng chưa chắc chậm hơn, ăn tiền ở chổ người ta dùng có 1 vòng lập
Ẹc... Ẹc...
Nếu tôi làm thì cũng thế thôi, tuy nhiên xin góp ý chổ này
- ReDim KQ(1 To UBound(VDL, 1), 1 To 7) ---> Sao bạn biết chắc là 7 cột?
Còn ThuNghi thì viết vầy:
- ReDim ArrKQ(1 To UBound(Arr), 1 To UBound(Arr)) ---> Sẽ lỗi nghiêm trọng nếu dữ liệu lớn
Vì vậy để chắc ăn nên dùng ReDim Preserve cho chiều thứ 2
Tôi giả lập 65536 dòng dữ liệu rồi, mọi người cứ lấy mà thí nghiệm

 

[Hoàng Trọng Nghĩa]

2 Dic cũng chưa chắc chậm hơn, ăn tiền ở chổ người ta dùng có 1 vòng lập
Ẹc... Ẹc...
Nếu tôi làm thì cũng thế thôi, tuy nhiên xin góp ý chổ này
- ReDim KQ(1 To UBound(VDL, 1), 1 To 7) ---> Sao bạn biết chắc là 7 cột?
Còn ThuNghi thì viết vầy:
- ReDim ArrKQ(1 To UBound(Arr), 1 To UBound(Arr)) ---> Sẽ lỗi nghiêm trọng nếu dữ liệu lớn
Vì vậy để chắc ăn nên dùng ReDim Preserve cho chiều thứ 2
Tôi giả lập 65536 dòng dữ liệu rồi, mọi người cứ lấy mà thí nghiệm

Thử cái này xem có được không ạ? Theo File của Thầy (65536 dòng):

Sub Array2Dicts()
    Dim i As Long, j As Long, iC As Long, iR As Long
    Dim sArray, MyArr, MyDict As Object
    Dim T As Double: T = Timer
    sArray = Sheet1.Range("A2:B65536").Value
    Set MyDict = CreateObject("Scripting.Dictionary")
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(sArray, 1)
            If Not .Exists(sArray(i, 1)) Then
                iC = iC + 1
                .Add sArray(i, 1), iC
            End If
        Next
        ReDim MyArr(1 To UBound(sArray, 1), 1 To iC + 1)
        iR = 1: j = 1
        For i = 1 To UBound(sArray, 1)
            If Not .Exists(sArray(i, 2)) Then
                iR = iR + 1
                MyArr(iR, 1) = sArray(i, 2)
                .Item(sArray(i, 2)) = iR
            End If
            If Not MyDict.Exists(sArray(i, 1)) Then
                j = j + 1
                MyDict(sArray(i, 1)) = j
                MyArr(1, j) = sArray(i, 1)
            End If
            MyArr(.Item(sArray(i, 2)), MyDict(sArray(i, 1))) = MyArr(.Item(sArray(i, 2)), MyDict(sArray(i, 1))) + 1
        Next
    End With
    With Sheet1.Range("F1").Resize(iR, iC)
        .ClearContents
        .Value = MyArr
    End With
    Set MyDict = Nothing
    Sheet1.Range("F1").Value = Timer - T
End Sub

Cẩn thận: Với Excel 2003, Khi B65536 có dữ liệu, các bạn không thể dùng cấu trúc này:

sArray = Range(Sheet1.[A2], Sheet1.[B65536].End(xlUp)).Value

(nếu dùng nó sẽ nhận dữ liệu có thể tương đương với Range("A1:B2") hoặc không lấy hết dữ liệu).

mà bắt buộc phải dùng cấu trúc này:

sArray = Sheet1.Range("A2:B65536").Value

 

[ndu96081631]

Thử cái này xem có được không ạ? Theo File của Thầy (65536 dòng):

Nếu khéo 1 chút thì vẫn có thể tăng tốc thêm được nữa đấy Ngoài ra xin nói thêm với nmhung49: Cách dùng 1 Dictionary chỉ đúng nếu bảo đảm chắc chắn rằng các phần tử ở 2 cột A, B là không bao giờ trùng nhau, nếu không sẽ cho kết quả sai quá xa luôn ---> Vậy tổng quát nhất vẫn nên dùng 2 Dic

 

[Hoàng Trọng Nghĩa]

Nếu khéo 1 chút thì vẫn có thể tăng tốc thêm được nữa đấy
Ngoài ra xin nói thêm với nmhung49: Cách dùng 1 Dictionary chỉ đúng nếu bảo đảm chắc chắn rằng các phần tử ở 2 cột A, B là không bao giờ trùng nhau, nếu không sẽ cho kết quả sai quá xa luôn ---> Vậy tổng quát nhất vẫn nên dùng 2 Dic

Thầy cứ úp úp mở mở làm em chẳng biết mô tê gì cả, Thầy làm luôn đi Thầy ơi!

 

[ndu96081631]

Thầy cứ úp úp mở mở làm em chẳng biết mô tê gì cả, Thầy làm luôn đi Thầy ơi!

Ví dụ chổ này:

MyArr(.Item(sArray(i, 2)), MyDict(sArray(i, 1))) = MyArr(.Item(sArray(i, 2)), MyDict(sArray(i, 1))) + 1

Thử sửa thành vày xem:

[COLOR=#ff0000][B]p1[/B][/COLOR] = .Item(sArray(i, 2)): [COLOR=#ff0000][B]p2[/B][/COLOR] = MyDict(sArray(i, 1))
MyArr([COLOR=#ff0000][B]p1[/B][/COLOR], [COLOR=#ff0000][B]p2[/B][/COLOR]) =MyArr([COLOR=#ff0000][B]p1[/B][/COLOR], [COLOR=#ff0000][B]p2[/B][/COLOR]) + 1

Với p1 và p2 là 2 biến Long
Thí nghiệm xem có nhanh hơn không?
Ẹc... Ẹc...