Vba thực hiện chậm khi dữ liệu tới 10 ngàn dòng (2 người xem)

[zerocoldtn]

File bên dưới thực hiện việc tách dữ liệu trong chuỗi, nhưng khi dữ liệu tới 10.000 dòng thì lệch thực hiện rất chậm. Các AC có cách nào thực hiện nhanh hơn bằng VBa không. Các AC chỉ giúp!

 

[SA_DQ]

Thử cách này xem sao:
Bước chuẩn bị:
(1) Thay cụm từ ", Việt Nam" (ở trang 'DuLieu") bằng dấu "."
(2) Thêm dấu chấm cuối các địa danh ở trang 'Tinh'
Bước thực hiện
Tạo 2 vòng lặp để duyệt:
A: Vòng lặp duyệt theo danh mục tỉnh
B: Vòng lặp duyệt theo danh mục địa chỉ
Nếu tìm thấy "tỉnh" trong danh mục trùng với trong địa chỉ thì ghi lại (Có thể xài làm InStr() trong VBA, hay . . . )
Bước Hoàn nguyên:
Làm ngược lại bước chuẩn bị

Ta có thể tăng tốc 2 vòng lặp bằng cách đưa chúng vô mảng mà duyệt.

Chúc thành công!

 

[snow25]

File bên dưới thực hiện việc tách dữ liệu trong chuỗi, nhưng khi dữ liệu tới 10.000 dòng thì lệch thực hiện rất chậm. Các AC có cách nào thực hiện nhanh hơn bằng VBa không. Các AC chỉ giúp!

Bạn thử code này xem.Mà mình thấy code kia cũng nhanh mà mất chưa đến 3s.

Sub tachtinh()
   Dim arr, i As Long, T, Lr As Long, a As Long
   Application.ScreenUpdating = False
   With Sheets("DATA")
       Lr = .Range("A" & Rows.Count).End(xlUp).Row
       If Lr < 2 Then Exit Sub
          .Range("B2:B" & Lr).ClearContents
          arr = .Range("A2:B" & Lr).Value
          For i = 1 To UBound(arr, 1)
             T = Split(arr(i, 1), ",")
             a = UBound(T) - 1
             If a > -1 Then arr(i, 2) = T(a)
          Next i
          .Range("A2:B" & Lr).Value = arr
End With
Application.ScreenUpdating = True
End Sub

 

[CHAOQUAY]

File bên dưới thực hiện việc tách dữ liệu trong chuỗi, nhưng khi dữ liệu tới 10.000 dòng thì lệch thực hiện rất chậm. Các AC có cách nào thực hiện nhanh hơn bằng VBa không. Các AC chỉ giúp!

Bạn test thử xem

Sub tach_tinh_()
On Error Resume Next
Dim i As Long, j As Long
Dim Nguon
Dim Kq
Worksheets("Data").Select
Nguon = Range("a2", Range("a2").End(xlDown))
j = UBound(Nguon)
ReDim Kq(1 To j, 1 To 1)
For i = 1 To j
    Kq(i, 1) = StrReverse(Trim(Split(StrReverse(Nguon(i, 1)), ",")(1)))
Next i
Range("b2").Resize(j, 1) = Kq
End Sub

 

[SA_DQ]

Ở Bặc Liệu có huyện Hòa Bình nha các bạn

 

[zerocoldtn]

Cám ơn các anh đã giúp đỡ, code chạy rất nhanh, thử gấp đôi số dòng mà chỉ cần 1 click!