Cải tiến Code bị chạy chậm

Liên hệ QC
Ngô Trường

Ngô Trường

Thành viên mới
Tham gia
25/8/20
Bài viết
3
Được thích
0
Các bác giúp e với, e mới học lập trình VBA, đang có cái job của công ty và gặp 1 vài vấn đề như này:
1 - e đã cải tiến code và còn như sau nhưng vẫn muốn nó nhanh hơn. Các bác giúp e xem e có thể cải tiến thêm mục nào nữa để nó có thể nhanh hơn được k với ạ.
2 - Khi mở ở máy e đang làm và chạy chương trình thì e đo time khoảng 5-6s nhưng khi mở ở máy người khác thì có máy 14-15s có máy 24-25s thì có cách nào khắc phục được k ạ?
3- Trong chương trình của e có đặt password cho phần VBA, khi chạy code mở userform lên thì khi tắt chương trình đi và lưu lại thì nó cứ bị hiện cái bảng nhập password của VBA lên và phải ấn cancel để tắt hẳn, e đã tìm hiểu mà k biết phải khắc phục như nào
Mong các bác xem giúp e ạ, e gửi 1 Sub chạy gây mất thời gian nhất trong chương trình mong các bác có thể giúp! Cảm ơn các bác đã xem!
 

File đính kèm

  • code.txt
    4.8 KB · Đọc: 21
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Ngô Trường đã viết:
Các bác giúp e với, e mới học lập trình VBA, đang có cái job của công ty và gặp 1 vài vấn đề như này:
1 - e đã cải tiến code và còn như sau nhưng vẫn muốn nó nhanh hơn. Các bác giúp e xem e có thể cải tiến thêm mục nào nữa để nó có thể nhanh hơn được k với ạ.
2 - Khi mở ở máy e đang làm và chạy chương trình thì e đo time khoảng 5-6s nhưng khi mở ở máy người khác thì có máy 14-15s có máy 24-25s thì có cách nào khắc phục được k ạ?
3- Trong chương trình của e có đặt password cho phần VBA, khi chạy code mở userform lên thì khi tắt chương trình đi và lưu lại thì nó cứ bị hiện cái bảng nhập password của VBA lên và phải ấn cancel để tắt hẳn, e đã tìm hiểu mà k biết phải khắc phục như nào
Mong các bác xem giúp e ạ, e gửi 1 Sub chạy gây mất thời gian nhất trong chương trình mong các bác có thể giúp! Cảm ơn các bác đã xem!
Nhấp chuột vào đây để mở rộng...
Bác phải gửi cả file nữa. chứ nhìn code thế kia biết làm thế nào
 
Upvote 0
BuiQuangThuan đã viết:
Bác phải gửi cả file nữa. chứ nhìn code thế kia biết làm thế nào
Nhấp chuột vào đây để mở rộng...
Tôi thì đọc cái mớ tiếng viết tắt, tiếng Tây mệt quá. Chạy.
Vả lại, code tiêu chuẩn mới là nghề của tôi. Còn tăng tốc thì không phải. Có nhiều bạn khác giỏi hơn.
 
Upvote 0
BuiQuangThuan đã viết:
Bác phải gửi cả file nữa. chứ nhìn code thế kia biết làm thế nào
Nhấp chuột vào đây để mở rộng...
Đúng nhìn code với tên biết nhức đầu :D
Trong này có một số ý bạn xem thử cải thiện thêm. Muốn cải thiện thì người ta phải hiểu ý bạn đang làm mới đưa ra tư vấn được, còn nhìn code vầy thì bói mù xem voi thôi.
Một số góp ý bạn có xem:
Tăng tốc cho code VBA của bạn
Về tốc độ xử lý của hàm Select Case trong VBA
Mình đoán cái khúc mà bạn bị chậm
PHP: 
            For for_DevT = 0 To for_DevT_loop Step 1

                Sheets(i).Select

                Sheets(i).Range(Cells(4 + temp_point, c), Cells(point_copy - temp_point + 3, c + 1)).Copy

                firstPaste = WorksheetFunction.CountA(Scomment.Range("A:A")) + 1
                
                Scomment.Cells(firstPaste, 1).PasteSpecial xlPasteValues

                Scomment.Select
                
                lastRow = WorksheetFunction.CountA(Scomment.Range("A:A"))

                Set RangePaste = Scomment.Range(Cells(firstPaste, 1), Cells(lastRow, 1))

                For Each CellsPaste In RangePaste
                    CellsPaste.Value = symbol(j) & CellsPaste.Value
                Next

                temp_point = temp_point + 100
                point_copy = point_copy + 200
            Next for_DevT
 
Upvote 0
Ngô Trường đã viết:
Các bác giúp e với, e mới học lập trình VBA, đang có cái job của công ty và gặp 1 vài vấn đề như này:
1 - e đã cải tiến code và còn như sau nhưng vẫn muốn nó nhanh hơn. Các bác giúp e xem e có thể cải tiến thêm mục nào nữa để nó có thể nhanh hơn được k với ạ.
2 - Khi mở ở máy e đang làm và chạy chương trình thì e đo time khoảng 5-6s nhưng khi mở ở máy người khác thì có máy 14-15s có máy 24-25s thì có cách nào khắc phục được k ạ?
3- Trong chương trình của e có đặt password cho phần VBA, khi chạy code mở userform lên thì khi tắt chương trình đi và lưu lại thì nó cứ bị hiện cái bảng nhập password của VBA lên và phải ấn cancel để tắt hẳn, e đã tìm hiểu mà k biết phải khắc phục như nào
Mong các bác xem giúp e ạ, e gửi 1 Sub chạy gây mất thời gian nhất trong chương trình mong các bác có thể giúp! Cảm ơn các bác đã xem!
Nhấp chuột vào đây để mở rộng...
Nghiên cứu mảng.Đừng thực hiện trên bảng excel như vậy mỗi lần nó copy 1 cái là excel nó lại phải tính toàn lại toàn bộ dữ liệu.
 
Upvote 0
BuiQuangThuan đã viết:
Hi vọng thớt đọc bài này rồi sửa bài viết nếu còn muốn mọi người hỗ trợ @Ngô Trường
Nhấp chuột vào đây để mở rộng...
Dạ nó là 1 project to to nên e k gửi được cả file do cũng liên quan đến công ty, e cũng muốn hỏi mọi người về cấu trúc nên k nghĩ là mấy cái viết tắt làm mọi người khó chịu vậy
Bài đã được tự động gộp:

huhumalu đã viết:
Đúng nhìn code với tên biết nhức đầu :D
Trong này có một số ý bạn xem thử cải thiện thêm. Muốn cải thiện thì người ta phải hiểu ý bạn đang làm mới đưa ra tư vấn được, còn nhìn code vầy thì bói mù xem voi thôi.
Một số góp ý bạn có xem:
Tăng tốc cho code VBA của bạn
Về tốc độ xử lý của hàm Select Case trong VBA
Mình đoán cái khúc mà bạn bị chậm
PHP: 
            For for_DevT = 0 To for_DevT_loop Step 1

                Sheets(i).Select

                Sheets(i).Range(Cells(4 + temp_point, c), Cells(point_copy - temp_point + 3, c + 1)).Copy

                firstPaste = WorksheetFunction.CountA(Scomment.Range("A:A")) + 1
               
                Scomment.Cells(firstPaste, 1).PasteSpecial xlPasteValues

                Scomment.Select
               
                lastRow = WorksheetFunction.CountA(Scomment.Range("A:A"))

                Set RangePaste = Scomment.Range(Cells(firstPaste, 1), Cells(lastRow, 1))

                For Each CellsPaste In RangePaste
                    CellsPaste.Value = symbol(j) & CellsPaste.Value
                Next

                temp_point = temp_point + 100
                point_copy = point_copy + 200
            Next for_DevT
Nhấp chuột vào đây để mở rộng...
cảm ơn bác, đoạn này có bỏ đi thì nó cũng k tăng thời gian lắm, để e làm thử theo bác bên dưới bảo dùng theo mảng xem sao
Bài đã được tự động gộp:

snow25 đã viết:
Nghiên cứu mảng.Đừng thực hiện trên bảng excel như vậy mỗi lần nó copy 1 cái là excel nó lại phải tính toàn lại toàn bộ dữ liệu.
Nhấp chuột vào đây để mở rộng...
để e nghiên cứu dùng theo mảng xem có nhanh hơn k, cảm ơn bác
 
Upvote 0
Ngô Trường đã viết:
Dạ nó là 1 project to to nên ...
Nhấp chuột vào đây để mở rộng...
Đã muốn làm đồ án to thì phải biết giao thiệp, chịu khó viết từ ngữ cho rõ rệt. Bạn không biết mình đã mất gì khi cố tình giữ thái độ.
Tuy GPE có rất nhiều tay code giỏi, giỏi hơn tôi nhiều. Nhưng số người có kinh nghiệm với đồ án không nhiều đâu.
 
Upvote 0
Ngô Trường đã viết:
Các bác giúp e với, e mới học lập trình VBA, đang có cái job của công ty và gặp 1 vài vấn đề như này:
1 - e đã cải tiến code và còn như sau nhưng vẫn muốn nó nhanh hơn. Các bác giúp e xem e có thể cải tiến thêm mục nào nữa để nó có thể nhanh hơn được k với ạ.
2 - Khi mở ở máy e đang làm và chạy chương trình thì e đo time khoảng 5-6s nhưng khi mở ở máy người khác thì có máy 14-15s có máy 24-25s thì có cách nào khắc phục được k ạ?
3- Trong chương trình của e có đặt password cho phần VBA, khi chạy code mở userform lên thì khi tắt chương trình đi và lưu lại thì nó cứ bị hiện cái bảng nhập password của VBA lên và phải ấn cancel để tắt hẳn, e đã tìm hiểu mà k biết phải khắc phục như nào
Mong các bác xem giúp e ạ, e gửi 1 Sub chạy gây mất thời gian nhất trong chương trình mong các bác có thể giúp! Cảm ơn các bác đã xem!
Nhấp chuột vào đây để mở rộng...
Chỉnh tàm tạm hy vong chạy được
Mã: 
Sub Find_Comment()
    Dim i, j, c As Integer
    Dim firstPaste, lastRow As Long
    Dim for_sheet, for_sheet_loop As Integer
    Dim for_Device, for_Device_Loop As Integer
    Dim for_time, for_time_loop As Integer
    Dim for_DevT, for_DevT_loop As Integer
    Dim point_copy, temp_point As Integer
    Dim CellsPaste, RangePaste As Range
    Dim symbol()

  symbol() = Array("M", "T", "D", "ZR", "L")
  for_sheet_loop = 18
  point_copy = 5000
  For for_sheet = 10 To for_sheet_loop Step 1
    i = for_sheet - 9 '****
    Select Case for_sheet
        Case 10 'sheet1 - Test
              for_Device_Loop = 2
              for_time_loop = 0
        Case 11 'sheet2 - Init
              for_Device_Loop = 4
              for_time_loop = 1
        Case 12 'sheet3 - Auto
              for_Device_Loop = 2
              for_time_loop = 1
        Case 13 'sheet4 - Error
              for_Device_Loop = 1
              for_time_loop = 0
        Case 14 'sheet5 - Manual
              for_Device_Loop = 0
              for_time_loop = 4
        Case 15 'sheet6 - Motion
              for_Device_Loop = 2
              for_time_loop = 5
        Case 16 'sheet7 - DataCim
              for_Device_Loop = 3
              for_time_loop = 0
        Case 17 'sheet8 - Data Process
              for_Device_Loop = 3
              for_time_loop = 0
        Case Else 'sheet9 - Interface
              for_Device_Loop = 2
              for_time_loop = 5
    End Select
    c = 5
    temp_point = 0
    For for_time = 0 To for_time_loop Step 1
      For for_Device = 0 To for_Device_Loop Step 1
        j = for_Device
        temp_point = 0
        If for_sheet = 11 And for_time = 0 And for_Device > 2 Then
            Exit For
        ElseIf for_sheet = 11 And for_time = 1 And for_Device = 2 Then
            GoTo SkipDevice
        ElseIf for_sheet = 11 And for_time = 1 And for_Device = 3 Then
            GoTo SkipDevice
        ElseIf for_sheet = 11 And for_time = 1 And for_Device = 4 Then
            c = 26
        End If
        If for_sheet = 15 And for_time < 5 And for_Device > 0 Then
            Exit For
        End If
        If for_sheet = 16 And for_Device = 2 Then
            c = c + 3
            GoTo SkipDevice
        End If
        If for_sheet = 17 And for_Device = 3 Then
            temp_point = 2900
        ElseIf for_sheet = 17 And for_Device = 1 Then
          for_DevT_loop = 39
          point_copy = 50
          temp_point = 0
          For for_DevT = 0 To for_DevT_loop Step 1
            With Sheets(i)
              arr = .Range(.Cells(4 + temp_point, c), .Cells(point_copy - temp_point + 3, c + 1)).Value
            End With
            For r = 1 To UBound(arr)
              arr(r, 1) = symbol(j) & arr(r, 1)
            Next r
            firstPaste = Scomment.Range("A" & Rows.Count).End(xlUp).Row + 1
            Scomment.Cells(firstPaste, 1).Resize(UBound(arr), UBound(arr, 2)) = arr
            temp_point = temp_point + 100
            point_copy = point_copy + 200
          Next for_DevT
          GoTo PassPaste
        End If
        With Sheets(i)
          arr = .Range(.Cells(4 + temp_point, c), .Cells(point_copy - temp_point + 3, c + 1)).Value
        End With
        For r = 1 To UBound(arr)
          arr(r, 1) = symbol(j) & arr(r, 1)
        Next r
        firstPaste = Scomment.Range("A" & Rows.Count).End(xlUp).Row + 1
        Scomment.Cells(firstPaste, 1).Resize(UBound(arr), UBound(arr, 2)) = arr
PassPaste:
        If for_Device < for_Device_Loop And for_sheet <> 11 Then
          c = c + 3
        ElseIf for_sheet = 11 And for_time = 0 And for_Device < 2 Then
          c = c + 3
        ElseIf for_sheet = 11 And for_time = 1 And for_Device < for_Device_Loop Then
          c = c + 3
        End If
SkipDevice:
      Next for_Device
      Select Case for_sheet
        Case 11 'sheet2 - Init
              c = c + 7
        Case 12 'sheet3 - Auto
              c = c + 7
        Case 14 'sheet5 - Manual
              c = c + 3
        Case 15 'sheet6 - Motion
              If for_time = 4 Then c = c + 1
        Case 18 'sheet9 - Interface
              c = c + 4
      End Select
    Next for_time
  Next for_sheet
End Sub
 
Upvote 0
Ngô Trường đã viết:
3- Trong chương trình của e có đặt password cho phần VBA, khi chạy code mở userform lên thì khi tắt chương trình đi và lưu lại thì nó cứ bị hiện cái bảng nhập password của VBA lên và phải ấn cancel để tắt hẳn, e đã tìm hiểu mà k biết phải khắc phục như nào
Nhấp chuột vào đây để mở rộng...
Cái này mình tìm hiểu được là do máy có cài chương trình Google Drive, file Excel nào có password VBA khi tắt đi là nó bị vậy. Mình biết nguyên nhân nhưng không biết cách khắc phục.
 
Upvote 0
HieuCD đã viết:
Chỉnh tàm tạm hy vong chạy được
Mã: 
Sub Find_Comment()
    Dim i, j, c As Integer
    Dim firstPaste, lastRow As Long
    Dim for_sheet, for_sheet_loop As Integer
    Dim for_Device, for_Device_Loop As Integer
    Dim for_time, for_time_loop As Integer
    Dim for_DevT, for_DevT_loop As Integer
    Dim point_copy, temp_point As Integer
    Dim CellsPaste, RangePaste As Range
    Dim symbol()

  symbol() = Array("M", "T", "D", "ZR", "L")
  for_sheet_loop = 18
  point_copy = 5000
  For for_sheet = 10 To for_sheet_loop Step 1
    i = for_sheet - 9 '****
    Select Case for_sheet
        Case 10 'sheet1 - Test
              for_Device_Loop = 2
              for_time_loop = 0
        Case 11 'sheet2 - Init
              for_Device_Loop = 4
              for_time_loop = 1
        Case 12 'sheet3 - Auto
              for_Device_Loop = 2
              for_time_loop = 1
        Case 13 'sheet4 - Error
              for_Device_Loop = 1
              for_time_loop = 0
        Case 14 'sheet5 - Manual
              for_Device_Loop = 0
              for_time_loop = 4
        Case 15 'sheet6 - Motion
              for_Device_Loop = 2
              for_time_loop = 5
        Case 16 'sheet7 - DataCim
              for_Device_Loop = 3
              for_time_loop = 0
        Case 17 'sheet8 - Data Process
              for_Device_Loop = 3
              for_time_loop = 0
        Case Else 'sheet9 - Interface
              for_Device_Loop = 2
              for_time_loop = 5
    End Select
    c = 5
    temp_point = 0
    For for_time = 0 To for_time_loop Step 1
      For for_Device = 0 To for_Device_Loop Step 1
        j = for_Device
        temp_point = 0
        If for_sheet = 11 And for_time = 0 And for_Device > 2 Then
            Exit For
        ElseIf for_sheet = 11 And for_time = 1 And for_Device = 2 Then
            GoTo SkipDevice
        ElseIf for_sheet = 11 And for_time = 1 And for_Device = 3 Then
            GoTo SkipDevice
        ElseIf for_sheet = 11 And for_time = 1 And for_Device = 4 Then
            c = 26
        End If
        If for_sheet = 15 And for_time < 5 And for_Device > 0 Then
            Exit For
        End If
        If for_sheet = 16 And for_Device = 2 Then
            c = c + 3
            GoTo SkipDevice
        End If
        If for_sheet = 17 And for_Device = 3 Then
            temp_point = 2900
        ElseIf for_sheet = 17 And for_Device = 1 Then
          for_DevT_loop = 39
          point_copy = 50
          temp_point = 0
          For for_DevT = 0 To for_DevT_loop Step 1
            With Sheets(i)
              arr = .Range(.Cells(4 + temp_point, c), .Cells(point_copy - temp_point + 3, c + 1)).Value
            End With
            For r = 1 To UBound(arr)
              arr(r, 1) = symbol(j) & arr(r, 1)
            Next r
            firstPaste = Scomment.Range("A" & Rows.Count).End(xlUp).Row + 1
            Scomment.Cells(firstPaste, 1).Resize(UBound(arr), UBound(arr, 2)) = arr
            temp_point = temp_point + 100
            point_copy = point_copy + 200
          Next for_DevT
          GoTo PassPaste
        End If
        With Sheets(i)
          arr = .Range(.Cells(4 + temp_point, c), .Cells(point_copy - temp_point + 3, c + 1)).Value
        End With
        For r = 1 To UBound(arr)
          arr(r, 1) = symbol(j) & arr(r, 1)
        Next r
        firstPaste = Scomment.Range("A" & Rows.Count).End(xlUp).Row + 1
        Scomment.Cells(firstPaste, 1).Resize(UBound(arr), UBound(arr, 2)) = arr
PassPaste:
        If for_Device < for_Device_Loop And for_sheet <> 11 Then
          c = c + 3
        ElseIf for_sheet = 11 And for_time = 0 And for_Device < 2 Then
          c = c + 3
        ElseIf for_sheet = 11 And for_time = 1 And for_Device < for_Device_Loop Then
          c = c + 3
        End If
SkipDevice:
      Next for_Device
      Select Case for_sheet
        Case 11 'sheet2 - Init
              c = c + 7
        Case 12 'sheet3 - Auto
              c = c + 7
        Case 14 'sheet5 - Manual
              c = c + 3
        Case 15 'sheet6 - Motion
              If for_time = 4 Then c = c + 1
        Case 18 'sheet9 - Interface
              c = c + 4
      End Select
    Next for_time
  Next for_sheet
End Sub
Nhấp chuột vào đây để mở rộng...
e cảm ơn bác ạ, để e sửa rồi chạy thử xem sao ạ
Bài đã được tự động gộp:

moihocvba đã viết:
Cái này mình tìm hiểu được là do máy có cài chương trình Google Drive, file Excel nào có password VBA khi tắt đi là nó bị vậy. Mình biết nguyên nhân nhưng không biết cách khắc phục.
Nhấp chuột vào đây để mở rộng...
e có tham khảo trên mạng mà cũng chưa biết cách giải quyết như nào ạ
Bài đã được tự động gộp:

VetMini đã viết:
Đã muốn làm đồ án to thì phải biết giao thiệp, chịu khó viết từ ngữ cho rõ rệt. Bạn không biết mình đã mất gì khi cố tình giữ thái độ.
Tuy GPE có rất nhiều tay code giỏi, giỏi hơn tôi nhiều. Nhưng số người có kinh nghiệm với đồ án không nhiều đâu.
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác đã góp ý
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

B
Nhờ anh/chị giúp em tìm hàm cho công thức tính lương
Trả lời
1
Đọc
59
Bobomkkk
B
N
Giúp em hàm Aggregate không chạy được trên Google sheet ah
Trả lời
2
Đọc
80
nguyenthieny
N
N
cộng các dữ liệu không trùng nhau
Trả lời
13
Đọc
210
DeTong
D
T
Lỗi import dữ liệu
Trả lời
1
Đọc
24
ongke0711
ongke0711
K
  • Question
Sử dụng Power Query để xử lý nhật ký chung nhiều nợ nhiều có
    • Cười
Trả lời
13
Đọc
238
ptm0412
ptm0412
Huy@@*
Giải đáp giùm em, cách khắc phục lỗi này trên VBA
2
Trả lời
28
Đọc
351
ptm0412
ptm0412
SA_DQ
Phẩu thuật Nụ cười lần 3 tại Huế.
    • Thích
Trả lời
0
Đọc
53
SA_DQ
SA_DQ
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
7 8 9
Trả lời
175
Đọc
9K
ongke0711
ongke0711
E
  • Question
Tạo bảng lọc theo điều kiện
Trả lời
7
Đọc
133
Hoàng Tuấn 868
H
Bùi Thúy Thúy
  • Question
Lấy dữ liệu thời tiết Accuweather để điền vào nhật ký thi công
2 3 4
Trả lời
62
Đọc
18K
HeSanbi
HeSanbi
vova2209
Index kết hợp với match 2 điều kiện
Trả lời
14
Đọc
1K
dunghtgiga
dunghtgiga
D
  • Question
Xin cách tạo tab và button cho Add-in trên ribbon Maintabs
Trả lời
2
Đọc
101
Decepticon
D
T
Chèn dữ liệu từ sheet này qua sheet khác theo điều kiện
Trả lời
3
Đọc
143
HieuCD
H
T
Trùng 2 lần: Tìm dữ liệu nhiều điều kiện
Trả lời
0
Đọc
87
Thulib
T
N
  • Question
Xin mã code ẩn hiện dòng theo điều kiện
Trả lời
10
Đọc
128
Nguyễn Diêu Hiền
N
N
Công thức tính số phù hợp với % mong muốn
Trả lời
9
Đọc
172
CHAOQUAY
C
B
Giúp em xử lý lỗi macro khi chạy VBA
2
Trả lời
21
Đọc
469
huhumalu
H
hunganh.nguyen
Xin giúp code tách dòng tổng thành những dòng chi tiết với giá trị là 1
Trả lời
6
Đọc
336
DeTong
D
T
cả nhà hỗ trợ giúp em là em phải dùng hàm gì cho đúng ạ, em làm mãi không được
    • Cười
Trả lời
2
Đọc
118
DeTong
D
nguyenanhhoa
Nhờ các bác giúp: e muốn tô màu khác nhau đối với các ô giống nhau về giá trị
    • Cười
Trả lời
7
Đọc
148
SA_DQ
SA_DQ
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom