Bạn thử đưa một phần file thật (khoảng vài trăm dòng dữ liệu) nếu không có gì phải bảo mật xem thế nào? Chú thích thêm điều kiện và ví dụ kết quả mong muốn.Code sử dụng vòng lặp For quá chậm
Mình dùng VBA để giảm dung lượng file, còn nếu đặt hàm IF cũng được.Bạn thử đưa một phần file thật (khoảng vài trăm dòng dữ liệu) nếu không có gì phải bảo mật xem thế nào? Chú thích thêm điều kiện và ví dụ kết quả mong muốn.
Mình thấy có lẽ chưa cần dùng đến VBA, bạn tham khảo file dưới đây.
Dữ liệu bạn ít quá, có thể thêm nhiều nhiều được không. Vấn đề của bạn cũng bình thường bạn ạ, nhưng 5 phút là quá lâu, bình thường thì mình đoán chắc dưới 1 giây.Mình dùng VBA để giảm dung lượng file, còn nếu đặt hàm IF cũng được.
Khi chạy 1 sheet riêng lẻ, mình thấy VBA code kèm theo file mình gửi chạy khá ổn, nhưng khi kết hợp vào file của mình thì chạy code mất tầm 5 phút mới xong.
Gán kết quả vào sheet tốn nhiều thời gian, dùng mảng chỉ gán kết quả 1 lầnEm đang chạy file dữ liệu khoảng 3-5k dòng, nhưng dùng hàm For-Next thấy chờ dài cổ luôn, nên xin chỉ dẫn của các anh chị em.
File ví dụ đính kèm, kèm luôn code em đã xây dựng.
Sub ABC()
Dim sArr(), Res(), sRow&, i&
With Sheet1
i = .Range("L" & Rows.Count).End(xlUp).Row 'Dong cuoi
If i < 8 Then MsgBox ("khong co du lieu"): Exit Sub
sArr = .Range("K7:K" & i).Value
End With
sRow = UBound(sArr)
ReDim Res(1 To sRow, 1 To 1)
For i = 1 To sRow
If sArr(i, 1) Like "T?I KHO?N*" Then
Res(i, 1) = Right(sArr(i, 1), 4)
Else
Res(i, 1) = Res(i - 1, 1)
End If
Next i
Sheet1.Range("G7").Resize(sRow) = Res
End Sub
Bạn xem giúp file này, sao nó lại lâu vậy nhỉ (mình có điều chỉnh giảm dữ liệu rồi vẫn chậmDữ liệu bạn ít quá, có thể thêm nhiều nhiều được không. Vấn đề của bạn cũng bình thường bạn ạ, nhưng 5 phút là quá lâu, bình thường thì mình đoán chắc dưới 1 giây.
Vâng, để mình nghiên cứu cái này xem, vì chưa học mảng nên đọc chưa hiểu lắmGán kết quả vào sheet tốn nhiều thời gian, dùng mảng chỉ gán kết quả 1 lần
Kiểm tra lại tài khoản thực tế, vì code lấy toàn bộ tài khoản
Mã:Sub ABC() Dim sArr(), Res(), sRow&, i& With Sheet1 i = .Range("L" & Rows.Count).End(xlUp).Row 'Dong cuoi If i < 8 Then MsgBox ("khong co du lieu"): Exit Sub sArr = .Range("K7:K" & i).Value End With sRow = UBound(sArr) ReDim Res(1 To sRow, 1 To 1) For i = 1 To sRow If sArr(i, 1) Like "T?I KHO?N*" Then Res(i, 1) = Right(sArr(i, 1), 4) Else Res(i, 1) = Res(i - 1, 1) End If Next i Sheet1.Range("G7").Resize(sRow) = Res End Sub
Sub XacDinhCacTaiKhoan()
Dim I As Long, DongCuoi As Long, Tmr As Double
Dim SoTK As String: Dim Rng As Range
Tmr = Time()
DongCuoi = Sheet1.Range("K" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For I = 8 To DongCuoi
SoTK = Right(Sheet1.Range("K" & I - 1), 4)
Set Rng = Sheet1.Range("G" & I)
If SoTK = "3511" Then
Rng.Value = 3511
ElseIf SoTK = "7111" Then
Rng.Value = 7111
ElseIf SoTK = "3582" Then
Rng.Value = 3582
Else:
Rng.Value = Sheet1.Range("G" & I - 1).Value
End If
Next I
Application.ScreenUpdating = True
MsgBox Timer() - Tmr, , DongCuoi
End Sub
Cảm ơn bạn, để tí nữa mình mở máy chạy thử. Thanks lần nữa...Bạn chạy thử macro này trên file của bạn; Mình chạy nó với hơn 5.500 dòng cũng ổn mà!
PHP:Sub XacDinhCacTaiKhoan() Dim I As Long, DongCuoi As Long, Tmr As Double Dim SoTK As String: Dim Rng As Range Tmr = Time() DongCuoi = Sheet1.Range("K" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False For I = 8 To DongCuoi SoTK = Right(Sheet1.Range("K" & I - 1), 4) Set Rng = Sheet1.Range("G" & I) If SoTK = "3511" Then Rng.Value = 3511 ElseIf SoTK = "7111" Then Rng.Value = 7111 ElseIf SoTK = "3582" Then Rng.Value = 3582 Else: Rng.Value = Sheet1.Range("G" & I - 1).Value End If Next I Application.ScreenUpdating = True MsgBox Timer() - Tmr, , DongCuoi End Sub
Mình vừa thử, thấy 2 phút rồi chưa xong. Bạn xem giúp file mình với, có vấn đề gì mình chưa xác định được.Bạn chạy thử macro này trên file của bạn; Mình chạy nó với hơn 5.500 dòng cũng ổn mà!
PHP:Sub XacDinhCacTaiKhoan() Dim I As Long, DongCuoi As Long, Tmr As Double Dim SoTK As String: Dim Rng As Range Tmr = Time() DongCuoi = Sheet1.Range("K" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False For I = 8 To DongCuoi SoTK = Right(Sheet1.Range("K" & I - 1), 4) Set Rng = Sheet1.Range("G" & I) If SoTK = "3511" Then Rng.Value = 3511 ElseIf SoTK = "7111" Then Rng.Value = 7111 ElseIf SoTK = "3582" Then Rng.Value = 3582 Else: Rng.Value = Sheet1.Range("G" & I - 1).Value End If Next I Application.ScreenUpdating = True MsgBox Timer() - Tmr, , DongCuoi End Sub
Mình mới tiếp xúc với VBA chắc trang tính sẽ còn chưa chuẩn được, bạn giúp mình lướt qua xem có thể khác phục được ko. Cảm ơn bạnChắc do file của bạn quá nhiều trang tính & biết đâu có cấu trúc vài trang nào đó chưa chuẩn(?)
Cảm ơn bạn, mình đã chỉnh code theo file của mình, không còn phải chờ đợi nữa. Chưa hiểu gì về mảng cả, để mình tìm hiểu, học hỏi thêm, thấy code bạn hoạt động nhanh thấy mê kiểu mảng quá.Gán kết quả vào sheet tốn nhiều thời gian, dùng mảng chỉ gán kết quả 1 lần
Kiểm tra lại tài khoản thực tế, vì code lấy toàn bộ tài khoản
Mã:Sub ABC() Dim sArr(), Res(), sRow&, i& With Sheet1 i = .Range("L" & Rows.Count).End(xlUp).Row 'Dong cuoi If i < 8 Then MsgBox ("khong co du lieu"): Exit Sub sArr = .Range("K7:K" & i).Value End With sRow = UBound(sArr) ReDim Res(1 To sRow, 1 To 1) For i = 1 To sRow If sArr(i, 1) Like "T?I KHO?N*" Then Res(i, 1) = Right(sArr(i, 1), 4) Else Res(i, 1) = Res(i - 1, 1) End If Next i Sheet1.Range("G7").Resize(sRow) = Res End Sub
Bạn tham khảo..Bạn xem giúp file này, sao nó lại lâu vậy nhỉ (mình có điều chỉnh giảm dữ liệu rồi vẫn chậm
Hình như giống giống cái code bạn HieuCD cung cấp ở trên, Cảm ơn bạnBạn tham khảo..
Mình chưa xem code của anh HieuCD, nhưng mỗi người có một cách viết khác nhau đấy bạn, bạn tham khảo càng nhiều càng tốt nhỉ.Hình như giống giống cái code bạn HieuCD cung cấp ở trên, Cảm ơn bạn
Lý thuyết mảng vốn khá đơn giản. Việc chuyển dữ liệu từ một range sang mảng và chuyển trở lại thật ra cần kiến thức range/cells nhiều hơn kiến thức mảng.Mình chưa xem code của anh HieuCD, nhưng mỗi người có một cách viết khác nhau đấy bạn, bạn tham khảo càng nhiều càng tốt nhỉ.
Góp vui cho bạn thêm một cách. Tuy nhiên tôi không so sánh về tốc độ.Em đang chạy file dữ liệu khoảng 3-5k dòng, nhưng dùng hàm For-Next thấy chờ dài cổ luôn, nên xin chỉ dẫn của các anh chị em.
File ví dụ đính kèm, kèm luôn code em đã xây dựng.
Sub Test_HLMT()
Dim strTk As String
With CreateObject("ADODB.Recordset")
.Open "SELECT * FROM [Sheet1$I7:K3000]", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=No""", 1, 3
Do Until .EOF
If !F3 Like "*TÀI KHO*" Then strTk = Right(!F3, 4)
!F1 = strTk
.MoveNext
Loop
End With
End Sub