Xin giúp đỡ cải thiệnn code copy có điều kiện (1 người xem)

[cartoon18]

em có một bảng tổng hợp chừng 40 column và 10.000 row , dựa vào những điều kiện ở những cột khác nhau để phân loại khách hàng em có viết một đoạn code để lọc ra những khách hàng cần quan tâm, nhưng đoạn code này em thấy chạy chậm quá, với lại trình bày cũng quá dài dòng. Mong các bác giúp em cải thiện tốc độ để tối ưu hơn ạ, em xin cảm ơn

 

[vu_tuan_manh_linh]

Tôi có cách nhanh hơn cả code!! Dùng phiên bản excel 2007 trở lên, filter bỏ tích vào chữ L, sau đó copy paste, xóa bớt cột không cần thiết đi.

 

[Quang_Hải]

em có một bảng tổng hợp chừng 40 column và 10.000 row , dựa vào những điều kiện ở những cột khác nhau để phân loại khách hàng em có viết một đoạn code để lọc ra những khách hàng cần quan tâm, nhưng đoạn code này em thấy chạy chậm quá, với lại trình bày cũng quá dài dòng. Mong các bác giúp em cải thiện tốc độ để tối ưu hơn ạ, em xin cảm ơn

Bạn thử 1 trong 2 code này

Option Base 1
Sub loc1()
Dim data(), Res(), I, K, x
data = Sheet1.Range("A2:K" & Sheet1.[K65536].End(3).Row).Value
ReDim Res(UBound(data) * 3, 6)
For x = 1 To 3
   For I = 1 To UBound(data)
      If data(I, 8 + x) <> "L" Then
         K = K + 1
         Res(K, 1) = data(I, 1)
         Res(K, 2) = data(I, 2)
         Res(K, 3) = data(I, 4)
         Res(K, x + 3) = data(I, 8 + x)
      End If
   Next
Next
Sheet2.[A2].Resize(K, 6) = Res
End Sub

Hoặc là

Sub loc2()
Dim data(), Res(), I, K, x
data = Sheet1.Range("A2:K" & Sheet1.[K65536].End(3).Row).Value
ReDim Res(UBound(data) * 3, 6)
For I = 1 To UBound(data)
   For x = 1 To 3
   If data(I, 8 + x) <> "L" Then
      K = K + 1
      Res(K, 1) = data(I, 1)
      Res(K, 2) = data(I, 2)
      Res(K, 3) = data(I, 4)
      Res(K, x + 3) = data(I, 8 + x)
   End If
   Next
Next
Sheet2.[A2].Resize(K, 6) = Res
End Sub

 

[cartoon18]

Tôi có cách nhanh hơn cả code!! Dùng phiên bản excel 2007 trở lên, filter bỏ tích vào chữ L, sau đó copy paste, xóa bớt cột không cần thiết đi.

- em đã nghĩ đến phương án filer và copy rồi nhưng mà vẫn chậm và mất công lắm, cho nên e mới nhờ đến VBA

Bạn thử 1 trong 2 code này

Option Base 1
Sub loc1()
Dim data(), Res(), I, K, x
data = Sheet1.Range("A2:K" & Sheet1.[K65536].End(3).Row).Value
ReDim Res(UBound(data) * 3, 6)
For x = 1 To 3
   For I = 1 To UBound(data)
      If data(I, 8 + x) <> "L" Then
         K = K + 1
         Res(K, 1) = data(I, 1)
         Res(K, 2) = data(I, 2)
         Res(K, 3) = data(I, 4)
         Res(K, x + 3) = data(I, 8 + x)
      End If
   Next
Next
Sheet2.[A2].Resize(K, 6) = Res
End Sub

Hoặc là

Sub loc2()
Dim data(), Res(), I, K, x
data = Sheet1.Range("A2:K" & Sheet1.[K65536].End(3).Row).Value
ReDim Res(UBound(data) * 3, 6)
For I = 1 To UBound(data)
   For x = 1 To 3
   If data(I, 8 + x) <> "L" Then
      K = K + 1
      Res(K, 1) = data(I, 1)
      Res(K, 2) = data(I, 2)
      Res(K, 3) = data(I, 4)
      Res(K, x + 3) = data(I, 8 + x)
   End If
   Next
Next
Sheet2.[A2].Resize(K, 6) = Res
End Sub

- Cảm ơn bác quanghai1969 em làm theo cách của bác thì thấy chạy nhanh hơn rất nhiều, hai đoạn code của bác đã đáp ứng được yêu cầu công việc của em rồi ạ