tối ưu code vba một cách dễ hiểu

[Dennisphan94]

xin chào mọi người

e gửi file thử nghiệm , vì mới học tập vba nên sao chép mỗi chức năng code , mong ai có thể tối ưu code bên dưới file giúp ạ

Bài đã được tự động gộp: 25/10/20

 

[PacificPR]

xin chào mọi người

e gửi file thử nghiệm , vì mới học tập vba nên sao chép mỗi chức năng code , mong ai có thể tối ưu code bên dưới file giúp ạ

Bài đã được tự động gộp: 25/10/20

View attachment 248029

File vẫn còn trên máy tính của Bạn kìa

 

[Dennisphan94]

File vẫn còn trên máy tính của Bạn kìa

file nặng quá không gửi lên được bạn haizz

 

[PacificPR]

file nặng quá không gửi lên được bạn haizz

Bạn xóa bớt dữ liệu đi. Để một ít làm tỉ dụ thoai

 

[Dennisphan94]

Option Explicit
Sub Combine()
Dim Dic As Object, I As Long, J As Long, Lr As Long, K As Long, Txt As String, sArr(), dArr()
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Transaction")
Lr = .Columns("A:C").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
If Lr < 2 Then Exit Sub
sArr = .Range("A2:B" & Lr).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
With Dic
For J = 1 To UBound(sArr, 2)
For I = 1 To UBound(sArr, 1)
Txt = Replace(sArr(I, J), " ", "")
If Not .exists(Txt) And Len(Txt) Then
K = K + 1
.Add Txt, K
dArr(K, 1) = Txt
End If
Next
Next
End With
.Range("D2" & .Rows.Count).ClearContents
.Range("D2").Resize(K) = dArr
End With
Set Dic = Nothing
End Sub

Sub copydata()
Dim wb As Workbook, wbmain As Workbook
Application.ScreenUpdating = False
Set wbmain = ThisWorkbook
Set wb = Workbooks.Open("C:\Users\ngocminh.phan\Desktop\cc.xlsx")
wb.Sheets("Transaction").Range("V2:X80000").Copy wbmain.Sheets("Transaction").Range("A2")
wb.Close False
End Sub
Sub Macro1()
'
' Macro1 Macro
'

'
Sheets("Transaction").Select
Range("A280000").Select
Application.CutCopyMode = False
Selection.ClearContents
Sheets("VBA").Select
Range("B1").Select
End Sub

Bài đã được tự động gộp: 25/10/20

Bạn xóa bớt dữ liệu đi. Để một ít làm tỉ dụ thoai

mình đã xóa nhưng sao nó vẫn nặng

Bài đã được tự động gộp: 25/10/20

 

[PacificPR]

Option Explicit
Sub Combine()
Dim Dic As Object, I As Long, J As Long, Lr As Long, K As Long, Txt As String, sArr(), dArr()
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Transaction")
Lr = .Columns("A:C").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
If Lr < 2 Then Exit Sub
sArr = .Range("A2:B" & Lr).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
With Dic
For J = 1 To UBound(sArr, 2)
For I = 1 To UBound(sArr, 1)
Txt = Replace(sArr(I, J), " ", "")
If Not .exists(Txt) And Len(Txt) Then
K = K + 1
.Add Txt, K
dArr(K, 1) = Txt
End If
Next
Next
End With
.Range("D2" & .Rows.Count).ClearContents
.Range("D2").Resize(K) = dArr
End With
Set Dic = Nothing
End Sub

Sub copydata()
Dim wb As Workbook, wbmain As Workbook
Application.ScreenUpdating = False
Set wbmain = ThisWorkbook
Set wb = Workbooks.Open("C:\Users\ngocminh.phan\Desktop\cc.xlsx")
wb.Sheets("Transaction").Range("V2:X80000").Copy wbmain.Sheets("Transaction").Range("A2")
wb.Close False
End Sub
Sub Macro1()
'
' Macro1 Macro
'

'
Sheets("Transaction").Select
Range("A280000").Select
Application.CutCopyMode = False
Selection.ClearContents
Sheets("VBA").Select
Range("B1").Select
End Sub

Bài đã được tự động gộp: 25/10/20

mình đã xóa nhưng sao nó vẫn nặng

Bài đã được tự động gộp: 25/10/20

Bạn xóa bớt đi để khoảng 50 dòng thôi xem nó còn nặng nữa không. Hoặc nén nó lại thử

 

[Dennisphan94]

Bạn xóa bớt đi để khoảng 50 dòng thôi xem nó còn nặng nữa không. Hoặc nén nó lại thử

mình gửi file rồi ạ , nhờ bạn xem giúp

 

[PacificPR]

???? lịch sự xíu bạn ơi , lên trên này học hỏi thui bạn

Trong file có 3 cái Sub
Cái Macro1 thì không tính. 1 cái kia Bạn đã được người ta viết hộ rồi. Vậy Bạn muốn làm gì nữa

 

[VetMini]

Trong file có 3 cái Sub
Cái Macro1 thì không tính. 1 cái kia Bạn đã được người ta viết hộ rồi. Vậy Bạn muốn làm gì nữa

Phân tích:
công việc: tối ưu
đối tượng: code VBA
điều kiện: dễ hiểu

Vấn đề:
Ở bên thớt kia có đã có mấy code "dễ hiểu" rồi. Nhưng theo thớt thì chưa "tối ưu".

Kết luận:
Muốn thử sức thì nhào vào.

Cẩn thận:
Còn thiếu một chuyện. Nhưng mà thớt muốn học code cho nên thôi để thớt tự tìm hiểu mình thiếu cái gì.

 

[huuthang_bd]

Chắc thiếu lễ độ

 

[befaint]

Vấn đề:
Ở bên thớt kia có đã có mấy code "dễ hiểu" rồi. Nhưng theo thớt thì chưa "tối ưu".

Bây giờ khúc này bị lủng rồi anh.

Bài của em lúc chiều là chép lại 100 / 100 nội dung của chủ thớt ở "thớt kia", hoàn toàn phù hợp (cung cấp thêm thông tin, nguồn gốc cho bài #1) mà vẫn bị xóa. Ca này khó hiểu.

 

[VetMini]

Chắc thiếu lễ độ

Không phải. Chuyện lễ nghĩa chỉ là chủ quan của tôi.

Đây nói chuyện khách quan. Không có cái đó bài toán như thầy bói sờ voi.