Code VBA cho kết quả dòng, cột theo điều kiện từ 2 Sheets

[hieuvietmy2020]

Em chào Anh Chị,

Hiện, em có viết 2 đoạn code để tính toán và trả kết quả theo file đính kèm, nhờ Anh Chị hướng dẫn thêm giúp em:
1. Đoạn "Sub GPE1" đang thực thi đúng kết quả (Em có note ở đoạn cần cải tiến cách viết gọn hơn trong đoạn code này);
2. Đoạn "Sub GPE2" em chưa rõ đang bị sai ở đâu, mà khi chạy code chỉ hiện biểu tượng Load;
3. Kết quả cuối cùng ở Sheets("CD") đang phải chạy Sub GPE1 tiếp đến Call GPE2 bên trong Sub GPE1, nhờ Anh Chị hướng dẫn giúp em cách để tối ưu 2 Sub về thành 1 Sub.

Em cảm ơn Anh Chị đã đọc bài viết ạ!

 

[VetMini]

1. Không có dân code chuyên nghiệp nào để cho cái With Object trải luôn một đoạn code dài dữ vậy. Về sau này cắt dời code sẽ có nhiều vấn đề.
2. Code không có comments cho biết mỗi tiểu đoạn của nó có mục đích gì. Bảo cải tiến rất khó - làm sao biết những chỗ x, y là chủ ý hay do code yếu.
Trước mắt chỉ thấy đóng If-Then-... có thể đổi thành Select Case
a = Array(Array(13085, 13180, 14065), Array(15185, 15910, 15165))
If DL1(i, 1) = DL0(j, 1) And DL1(i, 14) <> Empty Then
aA = 0
ElseIf DL1(i, 1) = DL0(j, 1) And DL1(i, 14) Like Empty Then
aA = 1
Else aA = -1
End If
If aA >=0 Then
Select Case n
Case 2 To 8
kq(j, n) = CgTh * a(aA)(0)
Case 9 To 12
kq(j, n) = CgTh * a(aA)(1)
Case 13 To 18
kq(j, n) = CgTh * a(aA)(2)
End Select
End If

3. Hai Subs có khai báo một số biến nội tên giống nhau, nhập code lại là điều không nên làm. Những chỗ mà sub 2 dựa vào trị mặc định của biến sẽ bị xáo trộn hết.

 

[SA_DQ]

Mình xin mạnh dạn gốp vài thiển ý nhỏ nhoi như sau:
a./ Về dữ liệu ở các trang tính
→ Cột 'B' ở trang 'CCH' & cột 'D' ở trang 'CD' tất cả chúng đều có tiếp đầu ngữ là 'ARL_'
Nếu là mình thì sẽ thay chỉ bằng 1 ký tự nào đó tùy thích như 'S', hay 'D' hoặc 'Q'. . . Điều này sẽ làm nhẹ file & nhẹ mắt người đọc file thêm xíu!
b./ Về hình thức trình bày Code của bạn chưa thẳng cột & như vậy trông lượm thượm hơn xíu;
Nếu là mình thì sẽ như sau:

Sub GPE1()
Dim DL0, DL1, kq, lr&, Cl0%, Cl1%, R%, C%, i%, j%, n%, t#, CgTh
Const DG = 12100:       t = Timer

With Sheets("CCH")
    .AutoFilterMode = 0
    Cl1 = .Cells(3, Columns.count).End(1).Column
1    DL1 = .Range(.Cells(5, 2), .Cells(517, Cl1)).Value
    .Range("A4:AL517" & lr).AutoFilter 1
End With
With Sheets("CD")
    Cl0 = .Cells(6, Columns.count).End(1).Column
2    DL0 = .Range(.Cells(6, 4), .Cells(518, Cl0 - 1)).Value
    R = UBound(DL0):     C = UBound(DL0, 2):  ReDim kq(4 To R, 1 To C)
    For i = 1 To UBound(DL1)
        For j = 1 To UBound(DL0)
            If DL1(i, 1) = DL0(j, 1) Then
                For n = 1 To C Step 2
                    kq(j, n) = DL1(i, 22) * DG
                Next n
            End If
            For n = 2 To 18 Step 2 ''Cach rut gon o doan nay de tang toc code
                CgTh = (DL1(i, n / 2 + 28) - DL1(i, n / 2 + 27))
                If DL1(i, 1) = DL0(j, 1) And DL1(i, 14) <> Empty Then
                    If n >= 2 And n <= 8 Then kq(j, n) = CgTh * 13085
                    If n > 8 And n <= 12 Then kq(j, n) = CgTh * 13180
                    If n > 12 And n <= 18 Then kq(j, n) = CgTh * 14065
                ElseIf DL1(i, 1) = DL0(j, 1) And DL1(i, 14) Like Empty Then
                    If n >= 2 And n <= 8 Then kq(j, n) = CgTh * 15185
                    If n > 8 And n <= 12 Then kq(j, n) = CgTh * 15910
                    If n > 12 And n <= 18 Then kq(j, n) = CgTh * 16165
                End If
            Next n ''
        Next j
    Next i
    .Range(.Cells(9, 6), .Cells(518, Cl0 - 1)).ClearContents
    .Range("F9").Resize(R - 3, C - 2) = kq
'Call GPE2 ''Khong thuc thi doan code nay, hien bieu tuong Load lien tuc
    .Range("F9").Resize(R - 3, C - 2).NumberFormat = "#,##0"
End With
Erase DL0, DL1, kq
MsgBox Timer - t
End Sub

Thêm 1 ý rất nhỏ này nữa:
Trong Code bạn có rất nhiều các hằng số; Các hằng này nên thực hiện như câu lệnh

Const DG = 12100

đã có của bạn; Mình cho là làm như vậy sẽ tiện trong việc ngắm nghía đứa con tinh thần của mình;
. . . . .

 

[hieuvietmy2020]

Em cảm ơn góp ý của Quý anh @VetMini và @SA_DQ

- Em đã cập nhật Select, trình bày lại và thêm Comment cho Code
- Em nhờ 2 anh hướng dẫn thêm để em có được kết quả cuối cùng khi dẫn Dữ Liệu từ Sheets("NKC") sang để tính toán ạ