Tối ưu code đưa dữ liệu ra sheet (1 người xem)

[phihndhsp]

Xin được các thành viên cho ý kiến về tối ưu hoá vấn đề thống kê sau
tôi có sheet data base chứa các dữ liệu cần thiết, và tôi có sheet kiểm tra tồn, trong sheet kiểm tra tồn hoàn toàn trống sau khi tôi nhấn nút thì nó đố dữ liệu ra trong file này tôi có 3 module
module 1 tôi lấy duy nhất tên cửa hảng đổ trên 1 hàng ( hàng thứ 7)
module 2 tôi lấy duy nhất mã hàng đổ vào cột A
module 3 tôi đổ tất cả dữ liệu vào bên trong( từ cột F ->...) lấy từ cột bán và cột tồn bên database

tôi muốn hỏi trong module tôi đưa dữ liệu ra từng ô từng ô, như vậy là không nhanh. Tôi muốn đưa tất cả dữ liệu đó vào mảng 2 chiều rồi resize ra mà không được, xin được sự giúp đỡ của các thành viên, xin chân thành cảm ơn

 

[phihndhsp]

Sau khi mày mò cuối cùng kết quả cũng ra như mong muốn là sử dụng mảng để gắng dữ liệu vào, nhưng mà tốc độ vẫn không được cải thiện
code module 3

Sub KIEMTRATON3(COT As Long, DONG As Long)
    
Dim Rngs(), Arr(), I As Long, K As Long, J As Long, J2 As Long
Dim TONGTON1, TONGBAN1, TONGTON, TONGBAN, TONGTONKHO As Long


On Error Resume Next
With Sheets("DATABASE")
    Rngs = .Range(.[A12], .[A60001].End(xlUp)).Resize(, 60).Value
End With
ReDim Arr(1 To DONG + 1, 1 To COT + 1)
ReDim Arr1(1 To DONG + 1, 1 To 3)


 Dim II, JJ As Long
    
    For I = 11 To DONG
   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   ''''DUA DU LIEU VAO COT TON COT F CACH NHAU 2 COT
            TONGBAN = 0
            TONGTON = 0
        For J = 6 To COT Step 2
                TONGTON1 = 0
                TONGBAN1 = 0
                TONGTONKHO = 0
          For K = 1 To UBound(Rngs, 1)
                If Rngs(K, 21) = Sheet16.Cells(I, 1) And Rngs(K, 42) = Sheet16.Cells(7, J) Then
                        TONGTON1 = TONGTON1 + Rngs(K, 12)
                        
                End If
                  If Rngs(K, 21) = Sheet16.Cells(I, 1) And Rngs(K, 42) = Sheet16.Cells(7, J + 1) Then
                      
                        TONGBAN1 = TONGBAN1 + Rngs(K, 8)
                       
                End If
                 If Rngs(K, 21) = Sheet16.Cells(I, 1) And Rngs(K, 42) = Sheet16.Cells(7, 5) Then
                        TONGTONKHO = TONGTONKHO + Rngs(K, 12)
                End If
                
           Next K
           
               
                
          
            
            Arr(I - 10, J - 1) = TONGTON1
            Arr(I - 10, J - 2) = TONGBAN1
             TONGBAN = TONGBAN + TONGBAN1
              TONGTON = TONGTON + TONGTON1
             
           
     Next J
           Arr(I - 10, 3) = TONGTONKHO
           Arr(I - 10, 1) = TONGBAN
           Arr(I - 10, 2) = TONGTON + TONGTONKHO
          
       Next I
     
   Sheets("KT ton kho").Range("C11").Resize(DONG, COT).Value = Arr


  End Sub

 

[VetMini]

Code của bạn mỗi lần xét thì nó truy cập tới 6 ô trên sheet16 --> 6 lần dời con trỏ. Và lượt xét lại đặt trong 3 vòng lặp lồng nhau - tức là có I*J*K lượt.

Trước mắt là tại sao đẩy dữ liệu tính vào array mà dữ liệu để so sánh bên sheet16 thì không?

 

[ptm0412]

Chỉ cần dùng Pivot table là được.