Dùng VBA tối ưu công thức

Liên hệ QC
L

levanhoa1977

Thành viên chính thức
Tham gia
10/10/11
Bài viết
62
Được thích
3
Mình đã đọc bài : "Dùng công thức nào đễ tăng tốc độ tính toán?".
-Dữ liệu ở sheet "Data" lên tới 60.000 và có thể hơn nữa.
-Sheet "Tong hop" số lượng khách hàng có thể lên tới cả trăm.
Mình sử dụng công thức sumproduct() giống như ở sheet "TONG HOP" thì file chạy rất chậm. Và sử dụng Sumifs() thì có cải thiện hơn tí. Nhưng phải sử dụng excel 2007. Nhưng dùng pivot table thì nhanh hơn nhiều nhưng báo cáo không linh động vì mình lấy tổng số lượng nhân với qui cách cho ra số lượng lẻ.

Mình nghĩ chỉ có VBA mới tối ưu được, nhưng mình thì không chuyên về code lắm. Mong nhận được sự giúp đỡ ace!

 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
levanhoa1977 đã viết:
Mình đã đọc bài : "Dùng công thức nào đễ tăng tốc độ tính toán?".
-Dữ liệu ở sheet "Data" lên tới 60.000 và có thể hơn nữa.
-Sheet "Tong hop" số lượng khách hàng có thể lên tới cả trăm.
Mình sử dụng công thức sumproduct() giống như ở sheet "TONG HOP" thì file chạy rất chậm. Và sử dụng Sumifs() thì có cải thiện hơn tí. Nhưng phải sử dụng excel 2007. Nhưng dùng pivot table thì nhanh hơn nhiều nhưng báo cáo không linh động vì mình lấy tổng số lượng nhân với qui cách cho ra số lượng lẻ.

Mình nghĩ chỉ có VBA mới tối ưu được, nhưng mình thì không chuyên về code lắm. Mong nhận được sự giúp đỡ ace!
Nhấp chuột vào đây để mở rộng...
Từ Cột A-> Cột G là cố định?
Nếu không bạn phải có thêm 1 danh mục sp gồm nhóm, quy cách và NPP nữa.
Tôi sẽ làm cho bạn từ cột H trở đi, có bao nhiêu KH thì lấy bao nhiêu theo tiêu chí thang=D1.
Y or N?
 
Upvote 0
Cảm ơn Bạn THuNghi, nội dung thì đúng ý mình rồi. Nhưng bạn có thể giải thích thêm về code đó được không? vì mình chưa hiểu lắm và muốn dựa theo đó mà chế biến thêm tí.
Cảm ơn
 
Upvote 0
levanhoa1977 đã viết:
Cảm ơn Bạn THuNghi, nội dung thì đúng ý mình rồi. Nhưng bạn có thể giải thích thêm về code đó được không? vì mình chưa hiểu lắm và muốn dựa theo đó mà chế biến thêm tí.
Cảm ơn
Nhấp chuột vào đây để mở rộng...

Code của anh ThuNghi hơi nặng tay nên nghiên cứu hơi mệt đấy. Nếu nghiên cứu thì thử code này nhé, chạy chậm tí nhưng tương đối dễ hiểu vì toàn những code cơ bản thôi.

PHP: 
Sub BAOCAO()
Dim kq(), masp, makh, dulieu
Dim i As Long, j As Long, x As Integer
With Sheets("data")
  dulieu = .Range(.[a5], .[a65536].End(3)).Resize(, 16).Value
End With
makh = Range([h3], [h3].End(2)).Value
masp = Range([a5], [a65536].End(3)).Resize(, 5).Value
ReDim kq(1 To UBound(masp), 1 To UBound(makh, 2))
  For j = 1 To UBound(dulieu)
    If dulieu(j, 16) = [d1] Then
      For i = 1 To UBound(masp)
        If UCase(masp(i, 1)) = UCase(dulieu(j, 1)) Then
          For x = 1 To UBound(makh, 2)
            If makh(1, x) = dulieu(j, 3) Then
              kq(i, x) = kq(i, x) + dulieu(j, 11) * masp(i, 5)
              Exit For
            End If
          Next
        End If
      Next
    End If
  Next
[h5].Resize(i - 1, UBound(makh, 2)) = kq
Erase kq
End Sub
 
Upvote 0
@ThuNghi
@quanghai1969
Vì bảo mật công ty nên minh cắt bớt sheet trong file nhưng lấy code về file gốc chỉnh sữa lại bị lỗi hoài nên đành gửi luôn file gốc.
-Dữ liệu lấy từ sheet data, Mã sản phẩm lấy cột B sheet data--> Lấy dữ liệu qua ( Sumproduct ) sheet temp (từ cột BO tới cột CR).
-File gốc:


Cảm ơn
 
Lần chỉnh sửa cuối:
Upvote 0
levanhoa1977 đã viết:
@ThuNghi
@quanghai1969
Vì bảo mật công ty nên minh cắt bớt sheet trong file nhưng lấy code về file gốc chỉnh sữa lại bị lỗi hoài nên đành gửi luôn file gốc.
-Dữ liệu lấy từ sheet data, Mã sản phẩm lấy cột B sheet data--> Lấy dữ liệu qua ( Sumproduct ) sheet temp (từ cột BO tới cột CR).
-File gốc:


Cảm ơn
Nhấp chuột vào đây để mở rộng...
Code có PW, không mở được làm sao mà giúp?
Nghỉ chơi vậy!
 
Upvote 0
levanhoa1977 đã viết:
@ThuNghi
@quanghai1969
Vì bảo mật công ty nên minh cắt bớt sheet trong file nhưng lấy code về file gốc chỉnh sữa lại bị lỗi hoài nên đành gửi luôn file gốc.
-Dữ liệu lấy từ sheet data, Mã sản phẩm lấy cột B sheet data--> Lấy dữ liệu qua ( Sumproduct ) sheet temp (từ cột BO tới cột CR).
-File gốc:


Cảm ơn
Nhấp chuột vào đây để mở rộng...
1/ Kg cho pass VBA thì sao mà mở
2/ Cấu trúc sh và tên sh có thay đổi nên phải sửa code thôi.
 
Upvote 0
levanhoa1977 đã viết:
@ThuNghi
@quanghai1969
Vì bảo mật công ty nên minh cắt bớt sheet trong file nhưng lấy code về file gốc chỉnh sữa lại bị lỗi hoài nên đành gửi luôn file gốc.
-Dữ liệu lấy từ sheet data, Mã sản phẩm lấy cột B sheet data--> Lấy dữ liệu qua ( Sumproduct ) sheet temp (từ cột BO tới cột CR).
-File gốc:


Cảm ơn
Nhấp chuột vào đây để mở rộng...

File gốc và file bạn gởi lúc đầu khác quá trời.
File bạn có pass
PHP: 
Sub BAOCAO()
Dim kq(), masp, makh, dulieu
Dim i As Long, j As Long, x As Integer
With Sheets("data")
  dulieu = .Range(.[a5], .[a65536].End(3)).Resize(, 18).Value
End With
makh = Range([bo3], [bo3].End(2)).Value
masp = Range([a6], [a65536].End(3)).Resize(, 5).Value
ReDim kq(1 To UBound(masp), 1 To UBound(makh, 2))
  For j = 1 To UBound(dulieu)
    If dulieu(j, 18) = [d1] Then
      For i = 1 To UBound(masp)
        If UCase(masp(i, 1)) = UCase(dulieu(j, 1)) Then
          For x = 1 To UBound(makh, 2)
            If makh(1, x) = dulieu(j, 4) Then
              kq(i, x) = kq(i, x) + dulieu(j, 12) * masp(i, 5)
              Exit For
            End If
          Next
        End If
      Next
    End If
  Next
[BO6].Resize(i - 1, UBound(makh, 2)) = kq
Erase kq
End Sub
 
Upvote 0
@ThuNghi

Pass :29061980. Code chỉ là lưu dữ liệu là lấy dữ liệu lên để in 4 liên thôi.
Cảm ơn.
 
Lần chỉnh sửa cuối:
Upvote 0
levanhoa1977 đã viết:
@ThuNghi

Pass :29061980. Code chỉ là lưu dữ liệu là lấy dữ liệu lên để in 4 liên thôi.
Cảm ơn.
Nhấp chuột vào đây để mở rộng...
Với cách tạo tmp như trên sẽ sinh ra thiếu sót là
1/ Những maHH có trong Data mà trong temp chưa list ra.
2/ Ngày cột 18 sh Data có lúc là TACH... => khó hiểu.
Tôi làm theo cấu trúc Temp của bạn ie có sẵn sườn BC => chỉ gán số từ BO thôi.
Kiểm tra lại maHH f07 và f07' của T8/12.
PHP: 
Sub MakeReport()
With Application
  .ScreenUpdating = False: .Calculation = xlCalculationManual: .EnableEvents = False
End With
Dim i&, endR&, iR&, iM&, iY&, iC&, nR&, nC&
Dim sMa$, sNPP$
Dim Dic01 As Object, Dic02 As Object
Dim sArr, ArrMH, ArrNPP, ArrKQ
Set Dic01 = CreateObject("Scripting.Dictionary")
Set Dic02 = CreateObject("Scripting.Dictionary")
'Lay data nguon
With Sheets("Data")
  On Error Resume Next
  .ShowAllData
  On Error GoTo 0
  endR = .Cells(65000, 1).End(xlUp).Row
  sArr = .Range("A5:U" & endR).Value
End With
'Lay dieu kien de loc
With Sheets("Temp")
  endR = .Cells(65000, 1).End(xlUp).Row
  .Range("BO6:CR" & endR).ClearContents
  ArrMH = .Range("A6:F" & endR).Value
  ArrNPP = .Range("BO3:CR3").Value
  iM = Month(.[D1]): iY = Year(.[D1])
End With
'Lay ma NPP duy nhat
For i = 1 To UBound(ArrNPP, 2)
  If Len(ArrNPP(1, i)) > 1 Then
    sNPP = UCase(ArrNPP(1, i))
    iC = iC + 1 'so cot tmp
    Dic01.Add sNPP, iC
  End If
Next i
'Lay ma HH
For i = 1 To UBound(ArrMH)
  If Len(ArrMH(i, 1)) > 0 Then
    sMa = UCase(ArrMH(i, 1))
    Dic02.Add sMa, i
  End If
Next i
iR = i - 1 'So dong cua tmp
ReDim ArrKQ(1 To iR, 1 To iC)
For i = 1 To UBound(sArr)
  If IsDate(sArr(i, 18)) Then
    If Year(sArr(i, 18)) = iY Then
      If Month(sArr(i, 18)) = iM Then
        If Len(sArr(i, 2)) > 0 Then
          sMa = UCase(sArr(i, 2))
          sNPP = sArr(i, 4)
          nC = Dic01.Item(sNPP)
          nR = Dic02.Item(sMa)
          If nR Then 'neu da co trong tmep
            If nC Then 'neu da co trong tmep
              ArrKQ(nR, nC) = ArrKQ(nR, nC) + (ArrMH(nR, 5) * sArr(i, 12)) 'SL theo tung ma va tung NPP
            End If
          End If
        End If
      End If
    End If
  End If
Next i
With Sheets("Temp")
  .[BO6].Resize(iR, iC) = ArrKQ
End With
With Application
  .ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .EnableEvents = True
End With
End Sub
 
Upvote 0
ThuNghi đã viết:
Với cách tạo tmp như trên sẽ sinh ra thiếu sót là
1/ Những maHH có trong Data mà trong temp chưa list ra.
2/ Ngày cột 18 sh Data có lúc là TACH... => khó hiểu.
Tôi làm theo cấu trúc Temp của bạn ie có sẵn sườn BC => chỉ gán số từ BO thôi.
Kiểm tra lại maHH f07 và f07' của T8/12.
PHP: 
Sub MakeReport()
With Application
  .ScreenUpdating = False: .Calculation = xlCalculationManual: .EnableEvents = False
End With
Dim i&, endR&, iR&, iM&, iY&, iC&, nR&, nC&
Dim sMa$, sNPP$
Dim Dic01 As Object, Dic02 As Object
Dim sArr, ArrMH, ArrNPP, ArrKQ
Set Dic01 = CreateObject("Scripting.Dictionary")
Set Dic02 = CreateObject("Scripting.Dictionary")
'Lay data nguon
With Sheets("Data")
  On Error Resume Next
  .ShowAllData
  On Error GoTo 0
  endR = .Cells(65000, 1).End(xlUp).Row
  sArr = .Range("A5:U" & endR).Value
End With
'Lay dieu kien de loc
With Sheets("Temp")
  endR = .Cells(65000, 1).End(xlUp).Row
  .Range("BO6:CR" & endR).ClearContents
  ArrMH = .Range("A6:F" & endR).Value
  ArrNPP = .Range("BO3:CR3").Value
  iM = Month(.[D1]): iY = Year(.[D1])
End With
'Lay ma NPP duy nhat
For i = 1 To UBound(ArrNPP, 2)
  If Len(ArrNPP(1, i)) > 1 Then
    sNPP = UCase(ArrNPP(1, i))
    iC = iC + 1 'so cot tmp
    Dic01.Add sNPP, iC
  End If
Next i
'Lay ma HH
For i = 1 To UBound(ArrMH)
  If Len(ArrMH(i, 1)) > 0 Then
    sMa = UCase(ArrMH(i, 1))
    Dic02.Add sMa, i
  End If
Next i
iR = i - 1 'So dong cua tmp
ReDim ArrKQ(1 To iR, 1 To iC)
For i = 1 To UBound(sArr)
  If IsDate(sArr(i, 18)) Then
    If Year(sArr(i, 18)) = iY Then
      If Month(sArr(i, 18)) = iM Then
        If Len(sArr(i, 2)) > 0 Then
          sMa = UCase(sArr(i, 2))
          sNPP = sArr(i, 4)
          nC = Dic01.Item(sNPP)
          nR = Dic02.Item(sMa)
          If nR Then 'neu da co trong tmep
            If nC Then 'neu da co trong tmep
              ArrKQ(nR, nC) = ArrKQ(nR, nC) + (ArrMH(nR, 5) * sArr(i, 12)) 'SL theo tung ma va tung NPP
            End If
          End If
        End If
      End If
    End If
  End If
Next i
With Sheets("Temp")
  .[BO6].Resize(iR, iC) = ArrKQ
End With
With Application
  .ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .EnableEvents = True
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Lấy dữ liệu tốt và cải thiện tốc độ file của mình rất nhiều.
Cảm ơn
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

72G1
File và thư mục
Trả lời
0
Đọc
1
72G1
72G1
kyo
  • Suggestion
Bài viết: SAP Scripting – Excel và SAP (P2)
    • Thích
Trả lời
14
Đọc
8K
pic vo123
P
S
Sao excel lại biến dữ liệu thành dữ liệu nhiều các con số?
Trả lời
12
Đọc
143
syquyen1987
S
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
Trả lời
4
Đọc
58
Hoàng Tuấn 868
H
N
  • Question
Mở từng file PDF ra in rồi đóng lại mở tiếp file khác trên cùng folder
Trả lời
8
Đọc
112
Hoàng Tuấn 868
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom