LGDMinhNC
Thành viên mới
- Tham gia
- 13/4/20
- Bài viết
- 16
- Được thích
- 1
- Giới tính
- Nam
Dear All,
Hiện em đang có 1 file report (File chính thì ở công ty không lấy ra được, em làm demo 1 file khác).
Em muốn tối ưu thời gian report vì data/month của em rất lớn, và các sếp muốn theo dõi cho nhiều tháng nên report rất lâu.
1 sheet có nhiều vùng cần count, em muốn mỗi lần report thì chỉ cần for 1 lần thôi. Bác nào có idea hay cách nào khác cho vấn đề này không ạ.
Chi tiết các bác xem file đính kèm giúp em nhé.
Tks.
Sub Report:
Function Get_Data:
Img - Excel:
Hiện em đang có 1 file report (File chính thì ở công ty không lấy ra được, em làm demo 1 file khác).
Em muốn tối ưu thời gian report vì data/month của em rất lớn, và các sếp muốn theo dõi cho nhiều tháng nên report rất lâu.
1 sheet có nhiều vùng cần count, em muốn mỗi lần report thì chỉ cần for 1 lần thôi. Bác nào có idea hay cách nào khác cho vấn đề này không ạ.
Chi tiết các bác xem file đính kèm giúp em nhé.
Tks.
Sub Report:
Mã:
Sub Report()
t = Timer
Dim Model As String
Dim Source As String
Dim Line As String
Dim Unit As String
Dim Shift As String
Dim ReportType As String
Dim SheetReport As Worksheet
Dim SheetRawdata As Worksheet
Dim ArrRawdata As Variant
Dim ArrDate As Variant
Dim ArrDefectName As Variant
Dim Res As Variant
Set SheetReport = ThisWorkbook.Sheets("Report")
Set SheetRawdata = ThisWorkbook.Sheets("Rawdata")
ArrRawdata = SheetRawdata.Range("B6:L" & SheetRawdata.Range("C1048576").End(3).Row)
ArrDate = SheetReport.Range("C11:T11")
ArrDefectName = SheetReport.Range("B12:B" & SheetReport.Range("B1048576").End(3).Row)
Model = SheetReport.[C2].Value2
Source = SheetReport.[C3].Value2
Line = SheetReport.[C4].Value2
Unit = SheetReport.[C5].Value2
Shift = SheetReport.[C6].Value2
'--> Sampling
ReportType = SheetReport.[B10].Value2
Res = Get_Data(ArrRawdata, ArrDate, ArrDefectName, ReportType, 8, Model, 3, Source, 4, Line, 5, Unit, 6, Shift, 7)
SheetReport.[C12].Resize(UBound(Res, 1), UBound(Res, 2)) = Res
'--> 100%
ReportType = SheetReport.[V10].Value2
Res = Get_Data(ArrRawdata, ArrDate, ArrDefectName, ReportType, 8, Model, 3, Source, 4, Line, 5, Unit, 6, Shift, 7)
SheetReport.[W12].Resize(UBound(Res, 1), UBound(Res, 2)) = Res
MsgBox "Summary Finshed: " & Format(Timer - t, "0.00"), , "MinhNC - Information"
End SubFunction Get_Data:
Mã:
Function Get_Data(ArrRawdata As Variant, ArrDate As Variant, ArrDefect As Variant, ReportType As String, ColReportType As Long, _
Model As String, ColModel As Long, Source As String, ColSource As Long, Line As String, ColLine As Long, _
Unit As String, ColUnit As Long, Shift As String, ColShift As Long)
Dim i As Long, j As Long, k As Long
Dim Res As Variant
Dim Dic As Object
Dim dItem As Long
Dim Pos As Long
ReDim Res(1 To UBound(ArrDefect, 1), 1 To UBound(ArrDate, 2))
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(ArrDefect, 1)
If ArrDefect(i, 1) <> "" Then
If Not Dic.exists(ArrDefect(i, 1)) Then
dItem = dItem + 1
Dic.Add ArrDefect(i, 1), dItem
End If
End If
Next
For j = 1 To UBound(ArrDate, 2)
For i = 1 To UBound(ArrRawdata, 1)
If ArrRawdata(i, 2) <> "" And Month(ArrRawdata(i, 2)) & "M" = ArrDate(1, j) Or _
Application.WorksheetFunction.WeekNum(ArrRawdata(i, 2)) & "W" = ArrDate(1, j) Or _
ArrRawdata(i, 2) = ArrDate(1, j) Then
If ArrRawdata(i, ColReportType) Like ReportType Then
If ArrRawdata(i, ColModel) Like Model Then
If ArrRawdata(i, ColSource) Like Source Then
If ArrRawdata(i, ColLine) Like Line Then
If ArrRawdata(i, ColUnit) Like Unit Then
If ArrRawdata(i, ColShift) Like Shift Then
For k = 10 To 11
If ArrRawdata(i, k) <> "" Then
Pos = Dic.Item(ArrRawdata(i, k))
Res(Pos, j) = Res(Pos, j) + 1
End If
Next
End If
End If
End If
End If
End If
End If
End If
Next
Next
Get_Data = Res
End FunctionImg - Excel:
