Xin nhờ mọi người sửa giúp code truy vấn sổ cái tk (1 người xem)

[khanhhero]

Em có làm file truy vấn sổ cái cho một người bạn, tuy nhiên vì dữ liệu rất lớn ( 7 tháng đầu năm hơn 200k dòng) nên em thấy tốc độ chạy khá chậm. Mong nhờ mọi người chỉnh sửa code lại giúp em để cải thiện tốc độ xử lý dữ liệu ạ.

Sub test()
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheet2.Activate
Sheet2.ShowAllData
Sheet2.Range(Sheet2.Range("A9"), Sheet2.Range("A1048576")).EntireRow.ClearContents
Dim arr
Dim i, j
Dim DK_1
j = 9
DK_1 = Sheet2.Range("D1").Value
arr = Sheet1.Range(Sheet1.Range("A4"), Sheet1.Range("A1048576").End(xlUp).Offset(0, 10)).Value

For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i, 4) = DK_1 And arr(i, 5) = DK_1 Then
Sheet2.Range("A" & j & "" & j).Value = Sheet1.Range("A" & i + 3 & "" & i + 3).Value
Sheet2.Cells(j, 5).Value = arr(i, 6)
Sheet2.Cells(j, 6).Value = arr(i, 6)
Sheet2.Range("G" & j & ":K" & j).Value = Sheet1.Range("G" & i + 3 & ":K" & i + 3).Value
j = j + 1
ElseIf arr(i, 4) = DK_1 Then
Sheet2.Range("A" & j & ":C" & j).Value = Sheet1.Range("A" & i + 3 & ":C" & i + 3).Value
Sheet2.Cells(j, 4).Value = arr(i, 5)
Sheet2.Cells(j, 5).Value = arr(i, 6)
Sheet2.Range("G" & j & ":K" & j).Value = Sheet1.Range("G" & i + 3 & ":K" & i + 3).Value
j = j + 1
ElseIf arr(i, 5) = DK_1 Then
Sheet2.Range("A" & j & ":C" & j).Value = Sheet1.Range("A" & i + 3 & ":C" & i + 3).Value
Sheet2.Cells(j, 4).Value = arr(i, 4)
Sheet2.Cells(j, 6).Value = arr(i, 6)
Sheet2.Range("G" & j & ":K" & j).Value = Sheet1.Range("G" & i + 3 & ":K" & i + 3).Value
j = j + 1

End If
Next i
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[Ba Tê]

Em có làm file truy vấn sổ cái cho một người bạn, tuy nhiên vì dữ liệu rất lớn ( 7 tháng đầu năm hơn 200k dòng) nên em thấy tốc độ chạy khá chậm. Mong nhờ mọi người chỉnh sửa code lại giúp em để cải thiện tốc độ xử lý dữ liệu ạ.

Tôi không phải kế toán nên không rõ lắm yêu cầu, chỉ làm "thí thí" theo kết quả bạn có sẵn thôi nhé, nếu sai thì "la lên"

Public Sub GPE()
Application.ScreenUpdating = False
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, DK As Variant
    sArr = Sheet1.Range("A4", Sheet1.Range("A4").End(xlDown)).Resize(, 12).Value
    R = UBound(sArr): ReDim dArr(1 To R, 1 To 12)
With Sheet2
    DK = .Range("D1").Value
    For I = 1 To R
        If sArr(I, 4) = DK Or sArr(I, 5) = DK Then
            K = K + 1
            dArr(K, 1) = sArr(I, 1): dArr(K, 2) = sArr(I, 2): dArr(K, 3) = sArr(I, 3)
            If sArr(I, 4) = DK Then
                dArr(K, 4) = sArr(I, 5): dArr(K, 5) = sArr(I, 6)
            End If
            If sArr(I, 5) = DK Then
                dArr(K, 4) = sArr(I, 4): dArr(K, 6) = sArr(I, 6)
            End If
            For J = 7 To 12
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    .Range("A9").Resize(500000, 12).ClearContents
    .Range("A9").Resize(K, 12) = dArr
End With
End Sub

 

[darknightno007]

Em có làm file truy vấn sổ cái cho một người bạn, tuy nhiên vì dữ liệu rất lớn ( 7 tháng đầu năm hơn 200k dòng) nên em thấy tốc độ chạy khá chậm. Mong nhờ mọi người chỉnh sửa code lại giúp em để cải thiện tốc độ xử lý dữ liệu ạ.

Chậm là do dùng cells nhiều quá, nên chậm đó. bạn chuyển hết về mảng rồi xử lý trên đó. xong ghi xuống lại sheet.

 

[concopcongiaiphapexcel]

Tôi không phải kế toán nên không rõ lắm yêu cầu, chỉ làm "thí thí" theo kết quả bạn có sẵn thôi nhé, nếu sai thì "la lên"

Public Sub GPE()
Application.ScreenUpdating = False
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, DK As Variant
    sArr = Sheet1.Range("A4", Sheet1.Range("A4").End(xlDown)).Resize(, 12).Value
    R = UBound(sArr): ReDim dArr(1 To R, 1 To 12)
With Sheet2
    DK = .Range("D1").Value
    For I = 1 To R
        If sArr(I, 4) = DK Or sArr(I, 5) = DK Then
            K = K + 1
            dArr(K, 1) = sArr(I, 1): dArr(K, 2) = sArr(I, 2): dArr(K, 3) = sArr(I, 3)
            If sArr(I, 4) = DK Then
                dArr(K, 4) = sArr(I, 5): dArr(K, 5) = sArr(I, 6)
            End If
            If sArr(I, 5) = DK Then
                dArr(K, 4) = sArr(I, 4): dArr(K, 6) = sArr(I, 6)
            End If
            For J = 7 To 12
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    .Range("A9").Resize(500000, 12).ClearContents
    .Range("A9").Resize(K, 12) = dArr
End With
End Sub

SUB của bác chạy nhanh quá, em tes hơn 100k dòng nhưng không hiểu sao lại có thể chạy nhanh vậy, em đang bắt đầu học mong bác có thể chú thích các dòng lệnh để em có thể tìm hiểu thêm, cảm ơn bác nhiều )

 

[concopcongiaiphapexcel]

Chậm là do dùng cells nhiều quá, nên chậm đó. bạn chuyển hết về mảng rồi xử lý trên đó. xong ghi xuống lại sheet.

em chưa biết về sử lý dữ liệu mảng, bác có biết topic nào không cho em xin link để có thể bắt đầu tìm hiểu ạ

 

[khanhhero]

Tôi không phải kế toán nên không rõ lắm yêu cầu, chỉ làm "thí thí" theo kết quả bạn có sẵn thôi nhé, nếu sai thì "la lên"

Public Sub GPE()
Application.ScreenUpdating = False
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, DK As Variant
    sArr = Sheet1.Range("A4", Sheet1.Range("A4").End(xlDown)).Resize(, 12).Value
    R = UBound(sArr): ReDim dArr(1 To R, 1 To 12)
With Sheet2
    DK = .Range("D1").Value
    For I = 1 To R
        If sArr(I, 4) = DK Or sArr(I, 5) = DK Then
            K = K + 1
            dArr(K, 1) = sArr(I, 1): dArr(K, 2) = sArr(I, 2): dArr(K, 3) = sArr(I, 3)
            If sArr(I, 4) = DK Then
                dArr(K, 4) = sArr(I, 5): dArr(K, 5) = sArr(I, 6)
            End If
            If sArr(I, 5) = DK Then
                dArr(K, 4) = sArr(I, 4): dArr(K, 6) = sArr(I, 6)
            End If
            For J = 7 To 12
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    .Range("A9").Resize(500000, 12).ClearContents
    .Range("A9").Resize(K, 12) = dArr
End With
End Sub

Thanks bác Ba Tê, code chạy rất ổn ạ, em cũng đang tập tành chuyển sang mảng, cám ơn bác lần nữa ạ.

 

[darknightno007]

em chưa biết về sử lý dữ liệu mảng, bác có biết topic nào không cho em xin link để có thể bắt đầu tìm hiểu ạ

Trên diễn đàn có bài về mảng đó. Bạn lên tìm hiểu thử.