Tối ưu hóa code để chạy nhanh hơn (2 người xem)

oaiprobq · 8/11/17

hôm nay em có lập 1 bảng excel tổ hợp nội lực cột, nhưng mà việc tổ hợp mất nhiều thời gian quá. Mong trên diễn đàn có bác nào rảnh rỗi giúp cháu sửa ( hoặc viết lại code ) cho nó chạy lẹ lẹ xíu ạ. Việc tổ hợp chả có gì nhiều cả, chỉ là tìm giá trị lớn nhất, nhỏ nhất của cột ( theo từng tầng + tên cột ), đưa nó lên đầu rồi xóa các dòng không chứa giá trị max, min thui

em đưa file mong cao nhân giúp xíu ạ

Hoang2013 · 8/11/17

Fải nói trước rằng bài toán loại này hằng năm đến mùa đều có xuất hiện. Hình như nó là loại đồ án hay gì gì đó;
Nhưng của bạn đưa lên tê 1 nổi là bài đăng thì tiếng Việt, mà trong File Excel thì tiếng nước ngoài. Như vậy là fần nào làm khó cho những người có nhã í muốn giúp bạn.
Theo mình, bạn nên sửa hoặc ở bài đăng cho giống với file hay ngược lại, Việt hóa các từ trong file.
Xài 2 thứ tiếng khó lắm, với không ít người!

oaiprobq · 8/11/17

Em xin up lại file như bác hoàng góp ý đây ạ.

TheThienChu · 8/11/17

oaiprobq đã viết:
Em xin up lại file như bác hoàng góp ý đây ạ.

Là lấy Max, Min của P hay M2 hay là M3.
Đồ án bê tông hà bồ tèo

PacificPR · 8/11/17

oaiprobq đã viết:
Em xin up lại file như bác hoàng góp ý đây ạ.

Bạn thử cái này xem sao

PHP:

Public Sub Locdulieu()
    Dim Dic As Object, Tem As String
    Dim sArr(), dArr(), I As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("ETAB")
    sArr = .Range("A2", .Range("A65535").End(3)).Resize(, 7).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 7)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1) & "#" & sArr(I, 2)
    If Not Dic.Exists(Tem) Then
        K = K + 1
        Dic.Add Tem, K
        dArr(K, 1) = sArr(I, 1): dArr(K, 2) = sArr(I, 2)
        dArr(K, 3) = sArr(I, 3): dArr(K, 4) = sArr(I, 4)
        dArr(K, 5) = sArr(I, 5): dArr(K, 6) = sArr(I, 6)
        dArr(K, 7) = sArr(I, 7)
    Else
        If dArr(Dic.Item(Tem), 5) >= sArr(I, 5) Then
            dArr(Dic.Item(Tem), 3) = sArr(I, 3)
            dArr(Dic.Item(Tem), 4) = sArr(I, 4)
            dArr(Dic.Item(Tem), 5) = sArr(I, 5)
            dArr(Dic.Item(Tem), 6) = sArr(I, 6)
            dArr(Dic.Item(Tem), 7) = sArr(I, 7)
        End If
    End If
Next I
With Sheets("DU LIEU LOC")
    .Range("A4:G5000").ClearContents
    .Range("A4").Resize(K, 7) = dArr
End With
Set Dic = Nothing
End Sub

Hoang2013 · 8/11/17

Mình sẽ hướng dẫn cách mà bạn làm với sự trợ giúp của VBA, hàm DMAX() & DMIN() sau đó là lọc (AdvancedFilter)
Bạn có thể thử vì trong khả năng của bạn & tốc độ không thua kém bao nhiêu sao với những fương fáp hiện đại khác trên GPE.COM:

(1) Bạn đến trang tính 'ETAB', nhập vô [AA1] & [AD1] công thức =g1
tương từ: [AB1]=B1 & [AC1]=c1
[AB2]= B2 & [AC2]=C2;
Nếu tại ô [AD2] bạn nhập công thức =DMAX(A:G;G1;AB1:AC2) sẽ xuất hiện con số 99468; là trị max của tấng & cột tương ứng (tầng 1; cột 17)
Tại dưới ô [AA1] ta nhập công thức tương ứng, ta sẽ nhân được trị trong nớ là -99,1497

(2) Nếu ta dùng vùng {AB1:AD2] để lọc từ CSDL thì ta sẽ có 1 (hay vài) hàng (dòng) kết quả ứng với trị MAX của tầng & cột trong điều kiện lọc;
Vùng [AA1:AC2] để lọc giá trị MIN của tầng & cột tương ứng.

(3) Tiếp theo, để có toàn bộ các hàng kết quả ứng với toàn bộ tấng & cột của CSDL thì ta lập 1 macro; Tạo vòng lặp gởi vô ô [AB2] & [AC2] tương ứng các 'tầng' & 'cột' từ 1 danh sách có sẵn là được toàn bộ kết quả lọc.

Với kiến thức VBA hiện nay của bạn (qua các macro trong file) mình nghĩ bạn thừa sức vượt qua fương án này!
Chúc bạn thành công.

quanluu · 8/11/17

oaiprobq đã viết:
hôm nay em có lập 1 bảng excel tổ hợp nội lực cột, nhưng mà việc tổ hợp mất nhiều thời gian quá. Mong trên diễn đàn có bác nào rảnh rỗi giúp cháu sửa ( hoặc viết lại code ) cho nó chạy lẹ lẹ xíu ạ. Việc tổ hợp chả có gì nhiều cả, chỉ là tìm giá trị lớn nhất, nhỏ nhất của cột ( theo từng tầng + tên cột ), đưa nó lên đầu rồi xóa các dòng không chứa giá trị max, min thui
em đưa file mong cao nhân giúp xíu ạ

Cos file access sao không làm trực tiếp trên đó, còn phải xuất ra excel làm gì nữa? không thì truy vấn trên access rồi xuất ra excel

oaiprobq · 8/11/17

PacificPR đã viết:

Bạn thử cái này xem sao

PHP:

Public Sub Locdulieu()
    Dim Dic As Object, Tem As String
    Dim sArr(), dArr(), I As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("ETAB")
    sArr = .Range("A2", .Range("A65535").End(3)).Resize(, 7).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 7)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1) & "#" & sArr(I, 2)
    If Not Dic.Exists(Tem) Then
        K = K + 1
        Dic.Add Tem, K
        dArr(K, 1) = sArr(I, 1): dArr(K, 2) = sArr(I, 2)
        dArr(K, 3) = sArr(I, 3): dArr(K, 4) = sArr(I, 4)
        dArr(K, 5) = sArr(I, 5): dArr(K, 6) = sArr(I, 6)
        dArr(K, 7) = sArr(I, 7)
    Else
        If dArr(Dic.Item(Tem), 5) >= sArr(I, 5) Then
            dArr(Dic.Item(Tem), 3) = sArr(I, 3)
            dArr(Dic.Item(Tem), 4) = sArr(I, 4)
            dArr(Dic.Item(Tem), 5) = sArr(I, 5)
            dArr(Dic.Item(Tem), 6) = sArr(I, 6)
            dArr(Dic.Item(Tem), 7) = sArr(I, 7)
        End If
    End If
Next I
With Sheets("DU LIEU LOC")
    .Range("A4:G5000").ClearContents
    .Range("A4").Resize(K, 7) = dArr
End With
Set Dic = Nothing
End Sub

cảm ơn bác ạ, code chạy nhanh hơn hẳn

.
p/s: code e đọc k hiểu lắm

oaiprobq · 8/11/17

quanluu1989 đã viết:
Cos file access sao không làm trực tiếp trên đó, còn phải xuất ra excel làm gì nữa? không thì truy vấn trên access rồi xuất ra excel

mình không biết dùng access

oaiprobq · 8/11/17

Hoang2013 đã viết:
Mình sẽ hướng dẫn cách mà bạn làm với sự trợ giúp của VBA, hàm DMAX() & DMIN() sau đó là lọc (AdvancedFilter)
Bạn có thể thử vì trong khả năng của bạn & tốc độ không thua kém bao nhiêu sao với những fương fáp hiện đại khác trên GPE.COM:

(1) Bạn đến trang tính 'ETAB', nhập vô [AA1] & [AD1] công thức =g1
tương từ: [AB1]=B1 & [AC1]=c1
[AB2]= B2 & [AC2]=C2;
Nếu tại ô [AD2] bạn nhập công thức =DMAX(A:G;G1;AB1:AC2) sẽ xuất hiện con số 99468; là trị max của tấng & cột tương ứng (tầng 1; cột 17)
Tại dưới ô [AA1] ta nhập công thức tương ứng, ta sẽ nhân được trị trong nớ là -99,1497

(2) Nếu ta dùng vùng {AB1:AD2] để lọc từ CSDL thì ta sẽ có 1 (hay vài) hàng (dòng) kết quả ứng với trị MAX của tầng & cột trong điều kiện lọc;
Vùng [AA1:AC2] để lọc giá trị MIN của tầng & cột tương ứng.

(3) Tiếp theo, để có toàn bộ các hàng kết quả ứng với toàn bộ tấng & cột của CSDL thì ta lập 1 macro; Tạo vòng lặp gởi vô ô [AB2] & [AC2] tương ứng các 'tầng' & 'cột' từ 1 danh sách có sẵn là được toàn bộ kết quả lọc.

Với kiến thức VBA hiện nay của bạn (qua các macro trong file) mình nghĩ bạn thừa sức vượt qua fương án này!
Chúc bạn thành công.

cảm ơn bác ạ

oaiprobq · 8/11/17

TheThienChu đã viết:
Là lấy Max, Min của P hay M2 hay là M3.
Đồ án bê tông hà bồ tèo

hè hè có phải đồ án gì đâu, lấy max của abs của 1 cái rồi tìm giá trị tương ứng

Hoang2013 · 9/11/17

Macro này cần gần 0.7 gy trên CSDL #3 (lớn gấp 7 lần so với macro #5)

PHP:

Sub HamCSDL()
 Dim ArrT(), ArrC(), Arr(), CSDL As Range, WF As Object, cRit As Range, Fld As Range
 Dim J As Long, zT As Integer, zC As Integer, Min_ As Double, Max_ As Double, W As Integer, Col As Byte
 Sheets("ETAB").Select:                             Set CSDL = [B2].CurrentRegion
 Set WF = Application.WorksheetFunction:            [n1:o1].Value = [A1:b1].Value
 Arr() = CSDL.Offset(1).Value:                      Tmr = Timer()
 ReDim dArr(1 To 999, 1 To 7)
 Sheets("DU LIEU LOC").[a4].Resize(999, 7).Value = dArr()
 ArrT() = Range([J2], [J2].End(xlDown)).Value:      ArrC() = Range([l2], [l2].End(xlDown)).Value
 Set cRit = [n1:O2]:                                Set Fld = [g1]
 For zT = 1 To UBound(ArrT())
    [n2].Value = ArrT(zT, 1)
    For zC = 1 To UBound(ArrC())
        [o2].Value = ArrC(zC, 1)
        Min_ = WF.DMin(CSDL, Fld, cRit):            Max_ = WF.DMax(CSDL, Fld, cRit)
        For J = 1 To UBound(Arr())
            If Arr(J, 1) = ArrT(zT, 1) And Arr(J, 2) = ArrC(zC, 1) Then
                If Arr(J, 7) = Min_ Or Arr(J, 7) = Max_ Then
                    W = W + 1
                    For Col = 1 To 7
                        dArr(W, Col) = Arr(J, Col)
                    Next Col
                End If
            End If
        Next J
    Next zC
 Next zT
 If W Then
    With Sheets("DU LIEU LOC")
        .[a4].Resize(W, 7).Value = dArr():          .[J1].Value = Timer() - Tmr
    End With
 End If
End Sub

(Mọi câu lệnh không cần kiến thức VBA nhiều cho lắm)

oaiprobq · 9/11/17

Hoang2013 đã viết:

Macro này cần gần 0.7 gy trên CSDL #3 (lớn gấp 7 lần so với macro #5)

PHP:

Sub HamCSDL()
 Dim ArrT(), ArrC(), Arr(), CSDL As Range, WF As Object, cRit As Range, Fld As Range
 Dim J As Long, zT As Integer, zC As Integer, Min_ As Double, Max_ As Double, W As Integer, Col As Byte
 Sheets("ETAB").Select:                             Set CSDL = [B2].CurrentRegion
 Set WF = Application.WorksheetFunction:            [n1:o1].Value = [A1:b1].Value
 Arr() = CSDL.Offset(1).Value:                      Tmr = Timer()
 ReDim dArr(1 To 999, 1 To 7)
 Sheets("DU LIEU LOC").[a4].Resize(999, 7).Value = dArr()
 ArrT() = Range([J2], [J2].End(xlDown)).Value:      ArrC() = Range([l2], [l2].End(xlDown)).Value
 Set cRit = [n1:O2]:                                Set Fld = [g1]
 For zT = 1 To UBound(ArrT())
    [n2].Value = ArrT(zT, 1)
    For zC = 1 To UBound(ArrC())
        [o2].Value = ArrC(zC, 1)
        Min_ = WF.DMin(CSDL, Fld, cRit):            Max_ = WF.DMax(CSDL, Fld, cRit)
        For J = 1 To UBound(Arr())
            If Arr(J, 1) = ArrT(zT, 1) And Arr(J, 2) = ArrC(zC, 1) Then
                If Arr(J, 7) = Min_ Or Arr(J, 7) = Max_ Then
                    W = W + 1
                    For Col = 1 To 7
                        dArr(W, Col) = Arr(J, Col)
                    Next Col
                End If
            End If
        Next J
    Next zC
 Next zT
 If W Then
    With Sheets("DU LIEU LOC")
        .[a4].Resize(W, 7).Value = dArr():          .[J1].Value = Timer() - Tmr
    End With
 End If
End Sub

(Mọi câu lệnh không cần kiến thức VBA nhiều cho lắm)

Em chạy thì bị lỗi Overlow như này ạ

Hoang2013 · 9/11/17

Vùng ArrT là danh sách các 'Tầng' đang có & duy nhất trong CSDL được cho vô mảng duyệt cho nhanh;
Tương tự như vậy với ArrC: Danh sách các 'cột' duy nhất có trong CSDL

Trước khi chạy macro nên có 2 danh sách này ở nơi mà nó fải có. Bạn nên dịch các câu lệnh sang tiếng Việt; Lúc đó mới xài macro của người khác viết 1 cách nhuần nhuyễn được.

TheThienChu · 9/11/17

oaiprobq đã viết:
hè hè có phải đồ án gì đâu, lấy max của abs của 1 cái rồi tìm giá trị tương ứng

Lỡ chọn được max ABS ( P ) mà tại dòng đó M2 hoặc M3 không max thì vẫn lấy cả dòng? +-+-+-+

oaiprobq · 9/11/17

TheThienChu đã viết:
Lỡ chọn được max ABS ( P ) mà tại dòng đó M2 hoặc M3 không max thì vẫn lấy cả dòng?

đúng rồi bạn.

oaiprobq · 9/11/17

Hoang2013 đã viết:
Vùng ArrT là danh sách các 'Tầng' đang có & duy nhất trong CSDL được cho vô mảng duyệt cho nhanh;
Tương tự như vậy với ArrC: Danh sách các 'cột' duy nhất có trong CSDL

Trước khi chạy macro nên có 2 danh sách này ở nơi mà nó fải có. Bạn nên dịch các câu lệnh sang tiếng Việt; Lúc đó mới xài macro của người khác viết 1 cách nhuần nhuyễn được.

thực sự thì trình độ của mình chưa bắt kịp macro của bạn

. Nhiều hàm mình chưa hiêu, nếu có thể bạn sửa giúp mình tks

Tối ưu hóa code để chạy nhanh hơn (2 người xem)

Người dùng đang xem chủ đề này

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên mới

File đính kèm

Thành viên tiêu biểu

Thành viên mới

Thành viên gắn bó

Thành viên gắn bó

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên gắn bó

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên tiêu biểu

Thành viên mới

Thành viên mới

Đếm ngược thời gian