Nhờ viết giùm VBA cho file dữ liệu khủng & quá nhiều công thức (1 người xem)

[phuplix]

Dear các bác

Trước hết cho em xin các ơn các bác đã dành thời gian xem bài này của em
Trước đây thỉnh thoảng em cũng có lên diễn đàn nhờ các bác viết giùm VBA , tuy nhiên đa số là các yêu cầu đơn giản; lần này nhờ các bác giúp em bài tập này với.

Do cái yêu cầu của em nó hơi nhiều , lủng cũng & các điều kiện hơi rối nên em xin chia nhỏ ra thành nhiều phần để diễn giải cho các bác hiểu.

Tổng quan:

File của em gồm 2 sheet :
Sheet đầu tiên là "List of sales", gồm thông tin các xe bán ra. Dữ liệu này hiện tại của em là hơn 70,000 dòng, và 20 cột
Sheet thứ hai là sheet "Intake vehicle" là thông tin các xe đã quay vào xưởng, dữ lieu là 100,000 dòng & 4 cột

Trong file ví dụ của em , em chỉ lấy một ít data làm mẫu thử cho các bác xem.
Em dùng hàm countifs mà đếm hết đám dữ lieu này thì "treo máy đến tết". Do đó nhờ các bác viết giùm em VBA thay thế cho các hàm tại sheet "List of sales" trước ạ.

Trước mắt các bác xem sơ qua file đính kèm giùm em nhé. Em sẽ giải thích them nếu các bác có thắc mắc

Em cám ơn các bác trước

 

[phuplix]

Các bác ơi, giúp em với !!!!

Huhuhu, file em add 10,000 dòng vào nó chạy xử lý hết gần 1 tiếng đồng hồ....

 

[phihndhsp]

Các bác ơi, giúp em với !!!!

Huhuhu, file em add 10,000 dòng vào nó chạy xử lý hết gần 1 tiếng đồng hồ....

nếu dữ liệu nhiều thì bạn nên tìm hiểu VBA chứ chạy công thức như thế này thì thua, bạn nên nêu rõ yêu cầu từng mục một, hết mục này ta tiếp mục khác, chứ đưa ra nhiều sợ mọi người ngán làm thôi

 

[huuthang_bd]

nếu dữ liệu nhiều thì bạn nên tìm hiểu VBA chứ chạy công thức như thế này thì thua, bạn nên nêu rõ yêu cầu từng mục một, hết mục này ta tiếp mục khác, chứ đưa ra nhiều sợ mọi người ngán làm thôi

Thì người ta nhờ giúp bằng VBA mà; và cũng yêu cầu từng mục mà.

Dear các bác

Trước hết cho em xin các ơn các bác đã dành thời gian xem bài này của em
Trước đây thỉnh thoảng em cũng có lên diễn đàn nhờ các bác viết giùm VBA , tuy nhiên đa số là các yêu cầu đơn giản; lần này nhờ các bác giúp em bài tập này với.

Do cái yêu cầu của em nó hơi nhiều , lủng cũng & các điều kiện hơi rối nên em xin chia nhỏ ra thành nhiều phần để diễn giải cho các bác hiểu.

Tổng quan:

File của em gồm 2 sheet :
Sheet đầu tiên là "List of sales", gồm thông tin các xe bán ra. Dữ liệu này hiện tại của em là hơn 70,000 dòng, và 20 cột
Sheet thứ hai là sheet "Intake vehicle" là thông tin các xe đã quay vào xưởng, dữ lieu là 100,000 dòng & 4 cột

Trong file ví dụ của em , em chỉ lấy một ít data làm mẫu thử cho các bác xem.
Em dùng hàm countifs mà đếm hết đám dữ lieu này thì "treo máy đến tết". Do đó nhờ các bác viết giùm em VBA thay thế cho các hàm tại sheet "List of sales" trước ạ.

Trước mắt các bác xem sơ qua file đính kèm giùm em nhé. Em sẽ giải thích them nếu các bác có thắc mắc

Em cám ơn các bác trước

Bạn thử code này nhé.

Sub TongHop()
Dim EndR As Long, ArrInfo, ArrData, ArrResult(), i As Long, j As Long, iR As Long, Dic, TmpStr As String
Dim StartDateOfYear As Long, EndDateOfYear As Long
EndR = Sheet3.Cells(&H100000, 5).End(xlUp).Row
ArrData = Sheet3.Range("C6:G" & EndR).Value2
EndR = Sheet1.Cells(&H100000, 1).End(xlUp).Row
ArrInfo = Sheet1.Range("B6:B" & EndR).Value2
ReDim ArrResult(1 To EndR - 5, 1 To 7)
Set Dic = VBA.CreateObject("Scripting.Dictionary")
For i = 1 To UBound(ArrInfo, 1)
    Dic.Item(ArrInfo(i, 1)) = i
Next
ArrInfo = Sheet1.Range("A6:A" & EndR).Value2
EndDateOfYear = Sheet1.Range("Y1").Value2
StartDateOfYear = VBA.DateSerial(Year(EndDateOfYear) - 1, Month(EndDateOfYear), Day(EndDateOfYear) + 1)
For i = 1 To UBound(ArrData, 1)
    If ArrData(i, 1) <= EndDateOfYear And Dic.Exists(ArrData(i, 3)) Then
        iR = Dic.Item(ArrData(i, 3))
        
        If ArrData(i, 1) >= StartDateOfYear Then
            If ArrData(i, 5) = ArrInfo(iR, 1) Then
                ArrResult(iR, 1) = ArrResult(iR, 1) + 1
            Else
                ArrResult(iR, 2) = ArrResult(iR, 2) + 1
            End If
        Else
            ArrResult(iR, 6) = ArrResult(iR, 6) + 1
        End If
    End If
Next
ArrInfo = Sheet1.Range("V6:V" & EndR).Value2
For iR = 1 To UBound(ArrResult, 1)
    ArrResult(iR, 3) = ArrResult(iR, 1) + ArrResult(iR, 2)
    ArrResult(iR, 4) = VBA.Switch(ArrInfo(iR, 1) > EndDateOfYear, "-", ArrInfo(iR, 1) > (EndDateOfYear - 90), "S1", True, Switch(ArrResult(iR, 3) = 0, "S4", ArrResult(iR, 3) < 3, "S3", True, "S2"))
    ArrResult(iR, 5) = ArrResult(iR, 3)
    ArrResult(iR, 7) = VBA.Switch(ArrInfo(iR, 1) > EndDateOfYear, "-", ArrInfo(iR, 1) > (EndDateOfYear - 90), "S1", True, Switch(ArrResult(iR, 5) > 0, "S2", ArrResult(iR, 6) > 0, "S3", True, "S4"))
Next
Sheet1.Range("X6:AD" & EndR).Value = ArrResult
End Sub

 

[phuplix]

Em xin cám ơn các bác rất nhiều sự giúp đỡ, đặc biệt là bác Hữu Thắng

Em đã test phần code của bác và chạy rất mượt mà

Tiếp nối phần đầu, xin nhờ các bác giúp tiếp em phần 2 là sheet thứ nhì trong file đính kèm của em
ở sheet này em có 6 cột, chủ yếu là các hàm vlookup và if, tuy nhiên dữ lieu dòng trong sheet này cũng khá khủng (hơn 200,000 dòng) nên nhờ các bác viết giúp em VBA nhé

Nếu hơi phức tạp vì phần của em thì các bác cứ reply nhé

Em xin cám ơn trước

 

[Ba Tê]

Em xin cám ơn các bác rất nhiều sự giúp đỡ, đặc biệt là bác Hữu Thắng

Em đã test phần code của bác và chạy rất mượt mà

Tiếp nối phần đầu, xin nhờ các bác giúp tiếp em phần 2 là sheet thứ nhì trong file đính kèm của em
ở sheet này em có 6 cột, chủ yếu là các hàm vlookup và if, tuy nhiên dữ lieu dòng trong sheet này cũng khá khủng (hơn 200,000 dòng) nên nhờ các bác viết giúp em VBA nhé

Nếu hơi phức tạp vì phần của em thì các bác cứ reply nhé

Em xin cám ơn trước

Viết cho bạn 1 code dựa vào công thức từng cột, dài "mút chỉ", chịu khó chạy thử nhé, không biết vài trăm ngàn dòng có chạy nổi không.

Public Sub GPE_2()
Dim Dic As Object, sArr(), dArr(), tArr(), Tem As String
Dim I As Long, J As Long, K As Long, Rws As Long, Ngay As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("List of sales Vehicle")
    sArr = .Range("B6", .Range("B6").End(xlDown)).Resize(, 30).Value
End With
ReDim tArr(1 To UBound(sArr), 1 To 10)
For I = 1 To UBound(sArr)
    Tem = sArr(I, 1)
    If Not Dic.Exists(Tem) Then
        K = K + 1
        Dic.Add Tem, K
        tArr(K, 1) = sArr(I, 21)
        tArr(K, 2) = sArr(I, 25)
        tArr(K, 3) = sArr(I, 28)
    End If
Next I
With Sheets("Intake vehicle data")
    Ngay = .Range("J1").Value
    sArr = .Range("C6", .Range("E6").End(xlDown)).Value
    ReDim dArr(1 To UBound(sArr), 1 To 10)
        For I = 1 To UBound(sArr)
            Tem = sArr(I, 3)
            If Dic.Exists(Tem) Then
                Rws = Dic.Item(Tem)
                dArr(I, 1) = tArr(Rws, 1)
                dArr(I, 2) = tArr(Rws, 2) - 1
                    If sArr(I, 1) - dArr(I, 1) < 90 Then
                        dArr(I, 3) = "S1"
                    ElseIf dArr(I, 2) <= 0 Then
                        dArr(I, 3) = "S4"
                    ElseIf dArr(I, 2) < 3 Then
                        dArr(I, 3) = "S3"
                    Else
                        dArr(I, 3) = "S2"
                    End If
                dArr(I, 4) = dArr(I, 2)
                dArr(I, 5) = tArr(Rws, 3) - 1
                    If dArr(I, 1) > Ngay Then
                        dArr(I, 6) = "-"
                    ElseIf dArr(I, 1) > Ngay - 90 Then
                        dArr(I, 6) = "S1"
                    ElseIf dArr(I, 4) > 0 Then
                        dArr(I, 6) = "S2"
                    ElseIf dArr(I, 5) > 0 Then
                        dArr(I, 6) = "S3"
                    Else
                        dArr(I, 6) = "S4"
                    End If
            End If
        Next I
    .Range("H6").Resize(I - 1, 6) = dArr
End With
Set Dic = Nothing
End Sub

 

[phuplix]

CÁM ƠN CÁC BÁC RẤT NHIỀU
CÁM ƠN CẢ THẦY BA TÊ... EM SẼ CHECK & BÁO KẾT QUẢ CHO THẦY SAU NHÉ

Tại sao phải tham chiếu cả cột B đến AA...mà không phải là giới hạn lại tới B1:AA100000, hay B1:AA200000 chẳng hạn...

100 ngàn dòng , 200 ngàn dòng...thì bạn phải ước lượng và tự giới hạn...Ở đây bạn chơi nguyên cả cột...có nghĩa là hơn cả 1 triệu dòng...thì làm sao nó chạy được...
=> NHÂN TIỆN EM HỎI NGU CÁI, GIẢ SỬ EM LÀM NHƯ BÁC HƯỚNG DẪN THÌ TỐC ĐỘ NÓ CẢI THIỆN ĐƯỢC CỠ BAO NHIÊU HẢ BÁC ? 20%, 30%, 50% ?

 

[rickypham]

Em thắc mắc cái đoạn này không biết anh BaTê hướng dẫn chi tiết được không ạ?

ReDim tArr(1 To UBound(sArr), 1 To 10)