Tối ưu hóa đoạn vba

maiban1986 · 18/8/21

chào anh chị. em đang dùng đoạn vba dưới, mỗi lần sử dụng dẫn đến file chạy rất chậm. nhờ anh chị có cách nào tối ưu đoạn vba dưới không. em xin cảm ơn
Sub GhepTextMulVung(Data, Vung As Range)
Dim avKQ()
Dim lngIndex As Long
Dim v
Dim lngNum As Long
Dim rngVung As Range, lngRowKQ As Long, lngRowData As Long, lngRowDataMax As Long
lngRowData = LBound(Data, 1) - 1
lngRowDataMax = UBound(Data)

For Each rngVung In Vung.Areas
If rngVung.Rows.Count = 1 Then
ReDim avKQ(1 To 1, 1 To 1)
Else
ReDim avKQ(1 To rngVung.Rows.Count, 1 To 1)
End If
For lngRowKQ = 1 To UBound(avKQ)
lngRowData = lngRowData + 1
If lngRowData > lngRowDataMax Then
Exit For
Else
avKQ(lngRowKQ, 1) = Data(lngRowData, 1)
End If

Next
rngVung.Value = avKQ

Next rngVung

End Sub

Cá ngừ F1 · 18/8/21

Bạn nên đưa file lên, mục đích và kết quả mong muốn là gì?
Đổi lại tên tiêu đề sát với câu hỏi, chứ đọc code thế này chưa hiểu là mục đích để làm gì?

Nhattanktnn · 18/8/21

maiban1986 đã viết:
chào anh chị. em đang dùng đoạn vba dưới, mỗi lần sử dụng dẫn đến file chạy rất chậm. nhờ anh chị có cách nào tối ưu đoạn vba dưới không. em xin cảm ơn
Sub GhepTextMulVung(Data, Vung As Range)
Dim avKQ()
Dim lngIndex As Long
Dim v
Dim lngNum As Long
Dim rngVung As Range, lngRowKQ As Long, lngRowData As Long, lngRowDataMax As Long
lngRowData = LBound(Data, 1) - 1
lngRowDataMax = UBound(Data)

For Each rngVung In Vung.Areas
If rngVung.Rows.Count = 1 Then
ReDim avKQ(1 To 1, 1 To 1)
Else
ReDim avKQ(1 To rngVung.Rows.Count, 1 To 1)
End If
For lngRowKQ = 1 To UBound(avKQ)
lngRowData = lngRowData + 1
If lngRowData > lngRowDataMax Then
Exit For
Else
avKQ(lngRowKQ, 1) = Data(lngRowData, 1)
End If

Next
rngVung.Value = avKQ

Next rngVung

End Sub

Đoán đại đại vậy:

Mã:

Sub GhepTextMulVung1(Data(), Vung As Range)
Dim I As Long, J As Long, K As Long, Rws As Long, KQ()
If UBound(Data) < UBound(Vung.Value) Then: Rws = UBound(Data): Else: Rws = UBound(Vung.Value)
ReDim KQ(1 To Rws, 1 To 1)
If Rws > 0 Then
    For I = 1 To Rws
        KQ(I, 1) = Data(I, 1)
    Next
    Vung.Resize(Rws, 1) = KQ
End If
End Sub
Sub abc()
Dim a(1 To 30, 1 To 3), c As Long
For c = 1 To UBound(a)
    a(c, 1) = c
Next
GhepTextMulVung1 a, Range("A1:A13")
End Sub

maiban1986 · 18/8/21

Nhattanktnn đã viết:

Đoán đại đại vậy:

Mã:

Sub GhepTextMulVung1(Data(), Vung As Range)
Dim I As Long, J As Long, K As Long, Rws As Long, KQ()
If UBound(Data) < UBound(Vung.Value) Then: Rws = UBound(Data): Else: Rws = UBound(Vung.Value)
ReDim KQ(1 To Rws, 1 To 1)
If Rws > 0 Then
    For I = 1 To Rws
        KQ(I, 1) = Data(I, 1)
    Next
    Vung.Resize(Rws, 1) = KQ
End If
End Sub
Sub abc()
Dim a(1 To 30, 1 To 3), c As Long
For c = 1 To UBound(a)
    a(c, 1) = c
Next
GhepTextMulVung1 a, Range("A1:A13")
End Sub

Cảm ơn đã hỗ trợ. ý em là đoạn code trên của em về bố cục có ổn không ạ. có cách nào tối ưu hơn được không. em xin cảm ơn

Cá ngừ F1 · 18/8/21

maiban1986 đã viết:
Cảm ơn đã hỗ trợ. ý em là đoạn code trên của em về bố cục có ổn không ạ. có cách nào tối ưu hơn được không. em xin cảm ơn

nghe lại càng mung lung? tối ưu theo bạn là như thế nào? code của bạn đã cho kết quả đúng? hay chỉ là nó chạy chậm?

Nhattanktnn · 18/8/21

maiban1986 đã viết:
Cảm ơn đã hỗ trợ. ý em là đoạn code trên của em về bố cục có ổn không ạ. có cách nào tối ưu hơn được không. em xin cảm ơn

Đó là mình đoán đại vậy thôi, còn nếu muốn chi tiết cụ thể thì phải có file, nêu yêu cầu chi tiết như bài #2 đã nói
Nhiều khi bạn code một đằng nhưng file bạn mong muốn nó lại một nẻo

maiban1986 · 18/8/21

Cá ngừ F1 đã viết:
nghe lại càng mung lung? tối ưu theo bạn là như thế nào? code của bạn đã cho kết quả đúng? hay chỉ là nó chạy chậm?

dạ kết quả đúng ạ. nhưng nó chậm quá anh ạ. anh xem có cách nào nó sử lý nhanh hơn được lữa không ạ. em cảm ơn anh đã tương tác

Nhattanktnn · 18/8/21

maiban1986 đã viết:
dạ kết quả đúng ạ. nhưng nó chậm quá anh ạ. anh xem có cách nào nó sử lý nhanh hơn được lữa không ạ. em cảm ơn anh đã tương tác

Coi bộ nói bạn đưa file lên mà khó khăn nhỉ.
Code đó chỉ có vấn đề ở chỗ redim liên tục trong mỗi vòng for và gán xuống sheet trong mỗi vòng for, cần sửa lại.
Nhưng mình nghĩ vấn đề chậm không phải chỉ ở đây, mà có lẽ sheet của bạn còn mớ công thức khủng. Khi gán xuống sheet phải tính toán nhiều mất thời gian

maiban1986 · 18/8/21

Nhattanktnn đã viết:
Coi bộ nói bạn đưa file lên mà khó khăn nhỉ.
Code đó chỉ có vấn đề ở chỗ redim liên tục trong mỗi vòng for và gán xuống sheet trong mỗi vòng for, cần sửa lại.
Nhưng mình nghĩ vấn đề chậm không phải chỉ ở đây, mà có lẽ sheet của bạn còn mớ công thức khủng. Khi gán xuống sheet phải tính toán nhiều mất thời gian

cảm ơn anh nhiều. cho em hỏi chỗ redim liên tục trong mỗi vòng for và gán xuống sheet anh có thể hỗ trợ em chỗ vùng này được không.

CHAOQUAY · 18/8/21

maiban1986 đã viết:
Sub GhepTextMulVung(Data, Vung As Range)
Dim avKQ()
Dim lngIndex As Long
Dim v
Dim lngNum As Long
Dim rngVung As Range, lngRowKQ As Long, lngRowData As Long, lngRowDataMax As Long
lngRowData = LBound(Data, 1) - 1
lngRowDataMax = UBound(Data)

For Each rngVung In Vung.Areas
If rngVung.Rows.Count = 1 Then
ReDim avKQ(1 To 1, 1 To 1)
Else
ReDim avKQ(1 To rngVung.Rows.Count, 1 To 1)
End If
For lngRowKQ = 1 To UBound(avKQ)
lngRowData = lngRowData + 1
If lngRowData > lngRowDataMax Then
Exit For
Else
avKQ(lngRowKQ, 1) = Data(lngRowData, 1)
End If

Next
rngVung.Value = avKQ

Next rngVung

End Sub

Thử thế này xem

Mã:

Sub GhepTextMulVung(Data, Vung As Range)
Dim avKQ()
Dim lngIndex As Long
Dim v
Dim lngNum As Long
Dim rngVung As Range, lngRowKQ As Long, lngRowData As Long, lngRowDataMax As Long
lngRowData = LBound(Data, 1) - 1
lngRowDataMax = UBound(Data)

ReDim avKQ(1 To 1000000, 1 To 1)
For Each rngVung In Vung.Areas
    For lngRowKQ = 1 To UBound(avKQ)
        lngRowData = lngRowData + 1
        If lngRowData > lngRowDataMax Then
            Exit For
        Else
            avKQ(lngRowKQ, 1) = Data(lngRowData, 1)
        End If
    Next
    rngVung.Value = avKQ
Next rngVung

End Sub

maiban1986 · 18/8/21

CHAOQUAY đã viết:

Thử thế này xem

Mã:

Sub GhepTextMulVung(Data, Vung As Range)
Dim avKQ()
Dim lngIndex As Long
Dim v
Dim lngNum As Long
Dim rngVung As Range, lngRowKQ As Long, lngRowData As Long, lngRowDataMax As Long
lngRowData = LBound(Data, 1) - 1
lngRowDataMax = UBound(Data)

ReDim avKQ(1 To 1000000, 1 To 1)
For Each rngVung In Vung.Areas
    For lngRowKQ = 1 To UBound(avKQ)
        lngRowData = lngRowData + 1
        If lngRowData > lngRowDataMax Then
            Exit For
        Else
            avKQ(lngRowKQ, 1) = Data(lngRowData, 1)
        End If
    Next
    rngVung.Value = avKQ
Next rngVung

End Sub

cảm ơn anh nhiều nhanh hơn 1 tý rồi ạ

Yeuvoyeucon · 18/8/21

maiban1986 đã viết:
cảm ơn anh nhiều nhanh hơn 1 tý rồi ạ

Bạn cho File về ứng dụng chạy được không ? Chưa hiểu nó làm gì ? Ghép các vùng dữ liệu với nhau hay sao bạn.

maiban1986 · 18/8/21

Yeuvoyeucon đã viết:
Bạn cho File về ứng dụng chạy được không ? Chưa hiểu nó làm gì ? Ghép các vùng dữ liệu với nhau hay sao bạn.

Dạ vâng đúng rồi ạ

Yeuvoyeucon · 18/8/21

maiban1986 đã viết:
Dạ vâng đúng rồi ạ

Bạn cho xin File mẫu ví dụ với được không. Thấy hay hay nên muốn xem nó hoạt động sao.

CHAOQUAY · 18/8/21

maiban1986 đã viết:
cảm ơn anh nhiều nhanh hơn 1 tý rồi ạ

Thử thêm 1 lần nữa nhé

Mã:

Option Explicit

Sub GhepTextMulVung(Data, Vung As Range)
Dim rngVung As Range
For Each rngVung In Vung.Areas
    rngVung.Value = Data
Next rngVung
End Sub

maiban1986 · 18/8/21

CHAOQUAY đã viết:
Thử thêm 1 lần nữa nhé

Mã:

Option Explicit Sub GhepTextMulVung(Data, Vung As Range) Dim rngVung As Range For Each rngVung In Vung.Areas rngVung.Value = Data Next rngVung End Sub

cảm ơn anh nhiều. code làm file chạy 8 giây nhanh hơn trước rồi

batman1 · 18/8/21

maiban1986 đã viết:
cảm ơn anh nhiều. code làm file chạy 8 giây nhanh hơn trước rồi

Nếu muốn cho người khác biết về mức độ cải thiện thì phải cho biết tổng thời gian chạy. 8 s chả nói lên cái gì cả. Nếu trước chạy mất 10 phút mà bây giờ nhanh hơn 8 s thì không có sự cải thiện đáng kể. Còn nếu trước chạy mất 12 s mà bây giờ nhanh hơn 8 s thì rõ ràng có sự cải thiện vượt bậc.

Theo lôgíc thì code bài #1 và #15 không tương đương. Các bài khác tôi không xem.

batman1 · 18/8/21

Yeuvoyeucon đã viết:
Bạn cho File về ứng dụng chạy được không ? Chưa hiểu nó làm gì ? Ghép các vùng dữ liệu với nhau hay sao bạn.

Người ta nói là GHÉP (bài #13) nhưng theo tôi không thể dùng từ GHÉP. Có chăng là "chia nhỏ", "rải", "điền" các giá trị trong mảng Data lần lượt vào các dòng liên tiếp của lần lượt các area của Vung.

Code "rải" các giá trị trong mảng Data lần lượt vào các Area. Mỗi vùng hình chữ nhật là 1 area. Vd. Vung1 tạo bởi B1:B5 là 1 area. Vung2 tạo bởi B1:B5, C1:C2 và D1: D3 gồm 3 area: area B1:B5, area C1:C2 và area D1: D3.

Vd. 1.
Data là mảng 11 giá trị liên tiếp 1, 2, ..., 11, còn Vung = Vung2. Sau khi chạy SUB có B1:B5 = 1, 2, ..., 5. C1:C2 = 6, 7, còn D1: D3 = 8, 9, 10. Giá trị 11 của mảng Data không dùng đến.

Vd. 2. Vẫn có Vung như trên nhưng Data chỉ có 9 giá trị từ 1 tới 9. Lúc này D3 = RỖNG vì sau khi "rải" 9 vào D2 thì code kết thúc.

HUONGHCKT · 18/8/21

Tôi xin góp thêm 1 ý nữa là: đã 17 bài rồi mà bài nào cũng yêu cầu bạn đưa cái file nên (chỉ là giả định thôi) mà không đáp ứng được, thử hỏi nếu là bạn là người muốn trợ giúp thì bạn nghĩ gì? Các thành viên của diễn đàn này cũng có rất rất nhiều việc cần làm, cần giúp người khác nữa chứ không phải chỉ cứ ngồi đoán mò ý tưởng của bạn để giúp bạn được.

CHAOQUAY · 19/8/21

batman1 đã viết:
Nếu muốn cho người khác biết về mức độ cải thiện thì phải cho biết tổng thời gian chạy. 8 s chả nói lên cái gì cả. Nếu trước chạy mất 10 phút mà bây giờ nhanh hơn 8 s thì không có sự cải thiện đáng kể. Còn nếu trước chạy mất 12 s mà bây giờ nhanh hơn 8 s thì rõ ràng có sự cải thiện vượt bậc.

Theo lôgíc thì code bài #1 và #15 không tương đương. Các bài khác tôi không xem.

Trong code bài 1, mảng avKQ là 2 chiều 1 cột vì vậy nên cho là Data cũng là 2 chiều 1 cột.
Có lẽ không có file giả định thì đoán thôi bác.

Tối ưu hóa đoạn vba

Thành viên thường trực

( ͡° ͜ʖ ͡°)

Thành viên gắn bó

Thành viên thường trực

( ͡° ͜ʖ ͡°)

Thành viên gắn bó

Thành viên thường trực

Thành viên gắn bó

Thành viên thường trực

Thành viên gắn bó

Thành viên thường trực

Thành viên hoạt động

Thành viên thường trực

Thành viên hoạt động

Thành viên gắn bó

Thành viên thường trực

Thành viên gạo cội

Thành viên gạo cội

Zalo 0986997214

Thành viên gắn bó

Facebook

Group