Cải thiện tốc độ của vba

[maiban1986]

chào anh chị xem có cách nào cải thiện tốc độ của vba này chạy nhanh hơn không. em xin cảm ơn.
Sub TrimData()
Dim Rng As Range
Dim cell As Range
Set Rng = Sheet1.Range("A1:O1000") 'Pham vi data can lam sach
For Each cell In Rng
cell.Value = Evaluate("IF(ROW(" & cell.Address & "),CLEAN(TRIM(" & cell.Address & ")))")
Next cell
End Sub

 

[Ba Tê]

chào anh chị xem có cách nào cải thiện tốc độ của vba này chạy nhanh hơn không. em xin cảm ơn.
Sub TrimData()
Dim Rng As Range
Dim cell As Range
Set Rng = Sheet1.Range("A1:O1000") 'Pham vi data can lam sach
For Each cell In Rng
cell.Value = Evaluate("IF(ROW(" & cell.Address & "),CLEAN(TRIM(" & cell.Address & ")))")
Next cell
End Sub

Bạn đưa file, nói rõ bạn muốn là gì, kết quả mẫu thế nào.
Đọc code không có file thử sao biết được sửa xong nó có nhanh hơn không?

 

[giaiphap]

Bạn đưa file, nói rõ bạn muốn là gì, kết quả mẫu thế nào.
Đọc code không có file thử sao biết được sửa xong nó có nhanh hơn không?

Thầy sửa bằng niềm tin đi, lúc nảy tui định sửa giúp nhưng không có dữ liệu để test và mình thì không có niềm tin nên thôi.

 

[SA_DQ]

Trong thời buổi giặc giả covid liên miên mà không có niềm tin thì con covid19 sẽ chén bạn ngay đó!

B1: Application.ScreenUpdating = False

 

[ptm0412]

Sửa đại, tin rằng nhanh ít nhất gấp đôi

Sub TrimData()
Dim Arr ()
Dim itm
Arr = Sheet1.Range("A1:O1000") 'Pham vi data can lam sach
For Each itm In Arr
    itm =Application.CLEAN(Application.TRIM(itm))
Next itm
Sheet1.Range("A1:O1000").Value = Arr
End Sub

 

[maiban1986]

Sửa đại, tin rằng nhanh ít nhất gấp đôi

Sub TrimData()
Dim Arr ()
Dim itm
Arr = Sheet1.Range("A1:O1000") 'Pham vi data can lam sach
For Each itm In Arr
    itm =Application.CLEAN(Application.TRIM(itm))
Next itm
Sheet1.Range("A1:O1000").Value = Arr
End Sub

Cám ơn Anh đã hỗ trợ nhưng cái hàm anh sửa nó không xóa được khoảng trắng thừa. xin cảm ơn

 

[ptm0412]

Bạn test chưa? Tôi có dùng Trim của VBA đâu?
À, sửa lại:

Sub TrimData()
Dim Arr()
Dim itm
Arr = Sheet1.Range("A1:O1000")
For i = 1 To UBound(Arr, 1)
    For j = 1 To UBound(Arr, 2)
        Arr(i, j) = Application.Clean(WorksheetFunction.Trim(Arr(i, j)))
    Next
Next
Sheet1.Range("A1:O1000").Value = Arr
End Sub

 

[befaint]

Bạn test chưa?

Khoảng trắng không chỉ có loại 32 mà anh. Và chủ thớt cũng đâu xác nhận code bài #1 đã ngon lành.

 

[ptm0412]

Khoảng trắng không chỉ có loại 32 mà anh. Và chủ thớt cũng đâu xác nhận code bài #1 đã ngon lành.

Có đủ hàm cờ lin và Trim y code gốc mừ, vả lại ngon lành hay không thì không biết, chỉ biết chạy ĐƯỢC RỒI và chỉ chậm thôi

 

[maiban1986]

Bạn test chưa? Tôi có dùng Trim của VBA đâu?
À, sửa lại:

Sub TrimData()
Dim Arr()
Dim itm
Arr = Sheet1.Range("A1:O1000")
For i = 1 To UBound(Arr, 1)
    For j = 1 To UBound(Arr, 2)
        Arr(i, j) = Application.Clean(WorksheetFunction.Trim(Arr(i, j)))
    Next
Next
Sheet1.Range("A1:O1000").Value = Arr
End
[/QUOTE]

Bạn test chưa? Tôi có dùng Trim của VBA đâu?
À, sửa lại:

Sub TrimData()
Dim Arr()
Dim itm
Arr = Sheet1.Range("A1:O1000")
For i = 1 To UBound(Arr, 1)
    For j = 1 To UBound(Arr, 2)
        Arr(i, j) = Application.Clean(WorksheetFunction.Trim(Arr(i, j)))
    Next
Next
Sheet1.Range("A1:O1000").Value = Arr
End Sub

em cảm ơn anh nhiều nhà. code mượt lắm xin cảm ơn

 

[HeSanbi]

@maiban1986​

Đa số hàm Excel đều xử lý được mảng, nên ta có thể dùng Evaluate

Private Sub test()
  Dim r as Range
  Set r = Sheet1.Range("A1:O1000")
  r.Value = r.Parent.Evaluate("=Clean(trim('" & r.Parent.Name & "'!" & r.Address & "))")
End Sub

 

[maiban1986]

@maiban1986​

Đa số hàm Excel đều xử lý được mảng, nên ta có thể dùng Evaluate

Private Sub test()
  Dim r as Range
  Set r = Sheet1.Range("A1:O1000")
  r.Value = r.Parent.Evaluate("=Clean(trim('" & r.Parent.Name & "'!" & r.Address & "))")
End Sub

A xin cảm ơn anh