Copy dữ liệu vào file đang đóng có điều kiện

Chia sẻ bởi:hands

★★★★★

‹ Chuẩn hóa Form về thành 1 form... Nhờ sửa code Chọn Sheet theo yêu... ›

Quảng cáo

Em xin chào các Anh Chị trên Diễn Đàn GPE và Anh hpkhuong

Vì Dữ liệu cần copy quá nhiều, nên khi chạy code thì bị lổi (out of memory).

Giờ mổi ngày em phải tự copy dữ liệu để chạy code, thì code không báo lổi nữa, vì mổi lần báo lổi thì em lại copy ít một chút cho đến khi nào chạy được thì thôi.

Nếu có thể copy 1 lần 1000 dòng paste vào file đang đóng, sau đó lại tiếp lục copy thêm 1000 dòng paste nói tiếp vào file đó thì sẽ không bị lổi nữa."Em nghỉ vậy, vì giờ mổi ngày em điều làm như vậy, mà cực quá, làm 1 thồi bị quán quán luôn".

Em Hy Vọng các Anh Chị trên Diễn Đàn GPE và Anh hpkhuong. có thể sửa lại code giúp em với.

Cho Em gửi lời Cảm Ơn trước à

Tác giả code trong file: hpkhuong

1. Tôi nghĩ bạn đừng nêu tên tôi lên đây thì sẽ có nhiều phương án tốt cho bạn. Không nhất thiết phải nghe theo 1 người… Với tôi thì tôi làm như vậy, và còn nhiều thành viên trên GPE này sẽ có rất nhiều giải pháp hay cho bạn… Cho nên đừng nếu đích danh là code của ai, không quan trọng chuyện đó. (Code là học hỏi lẫn nhau mà ra, có ai tự ngồi sáng tạo ra cái thứ ngôn ngữ ấy đâu.)

2. Bạn nói rằng bạn chạy code nhiều dữ liệu bị lỗi, Mà trong khi post lên đây lèo tèo có vài dòng…Tôi hay ai đó có test cho bạn, cũng làm sao mà phát sinh lỗi được. Cho nên khó mà hiểu file thật của bạn, bạn áp dụng như nào mà lỗi… Với file đinh dạng 2007 trở lên thì có cả hơn 1 triệu dòng, hơn cả 1000 cột lận mà. Sao lại lỗi tràn được ta

Với lai: File thật của bạn, file A chạy code của bạn có tất cả bao nhiều dòng dữ liệu? Rồi mõi mã hàng tương ứng với file A thì sẽ có khoản bao nhiêu dòng khi chạy code nó update vào file đích???

30 File Không báo lổi vi dữ liệu còn ít, Anh cứ chạy thử trước.
—

Lổi (out of memory)
Bước 1, Chạy code Giả lập dữ liệu thật, sau đó đợi code chạy xong.(Phải chạy code này vì dữ liệu thật nhiều y như vậy, hàng và cột y như vậy không khác 1 chút nào)

Bước 2, Chạy code chia dữ liệu vào file đang đóng. Sẽ báo lổi(out of memory)

Dữ liệu có 30 Mã Hàng và 30 file con

Nếu có thể copy 1 lần 1000 dòng paste vào file đang đóng, sau đó lại tiếp lục copy thêm 1000 dòng paste nói tiếp vào file đó thì có thể được không Anh

1. Dữ liệu của bạn nhiều vậy chạy VBA thì nó out of memory là đúng rồi… Cái này thì thua rồi… Bạn có thể search từ khóa ADO trên GPE để tìm giải pháp tốt hơn (tôi không rành ADO). Chứ VBA thì nhiều dòng như của bạn thì khó mà kham nổi.

2. Cái sub chạy giả lập của bạn chỉ cần vầy là đủ, làm chi mà select tùm lum vậy

Sub CopyGiaLap()
Application.ScreenUpdating = False
    Sheet2.Range("B1:BK30").Copy Sheet1.Range("B11:B600010")
Application.ScreenUpdating = True
End Sub

B600010 ở trên bạn có thể thay số lớn hơn nếu dữ liệu của bạn nhiều hơn: 600010 ở trên là lấy 30*20000 +10 đó.

3. Còn sub update dữ liệu của bạn sửa lại như này: Nhưng nếu dữ liệu của bạn nhiều như vậy thì chạy sub thì đi uống 10 li cafe cũng chưa chắc chạy xong đâu…

Sub Test100()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ChonO As Object, ChonF As Object, pFile, Path, ShName As String, TyName As String
Dim fil As Object, Wb As Workbook, Sh As Worksheet, WbMain As Workbook, OldName As String
Dim Arr, dArr, I As Long, K As Long, MH As String, DateF As Date, NewName As String
Dim Dic As Object, Tem As String, J As Long, n As Long
Set WbMain = ActiveWorkbook
pFile = WbMain.Name
DateF = WbMain.Sheets("DULIEUTONG").Range("Q9").Value
Arr = WbMain.Sheets("DULIEUTONG").Range("B11", WbMain.Sheets("DULIEUTONG").Range("B11").End(4)).Resize(, 62).Value
ReDim dArr(1 To UBound(Arr), 1 To UBound(Arr, 2))
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = ""
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    Path = .SelectedItems(1) & ""
End With
Set Dic = CreateObject("Scripting.Dictionary")
K = 0
For J = 1 To UBound(Arr)
Tem = Arr(J, 1)
If Tem <> Empty And Not Dic.exists(Tem) Then
    Dic.Add Tem, ""
    MH = Tem
Set ChonO = CreateObject("Scripting.FilesystemObject")
Set ChonF = ChonO.GetFolder(Path)
K = 0
For Each fil In ChonF.Files
If InStr(1, fil.Name, pFile) <= 0 Then
    ShName = ChonO.GetBaseName(fil)
    TyName = ChonO.GetExtensionName(fil)
    If Left(ShName, Len(MH)) = MH Then
        Set Wb = Workbooks.Open(fil.Path, , , , "AAA")
        Set Sh = Wb.Sheets("DULIEU")
        K = 0
            For I = 1 To UBound(Arr)
                If Arr(I, 1) = MH Then
                    K = K + 1
                    dArr(K, 1) = K
                    For n = 2 To UBound(Arr, 2)
                        dArr(K, n) = Arr(I, n)
                    Next n
                End If
            Next I
        Sh.Range("A2", Sh.Range("A2").End(4)).Resize(, UBound(Arr, 2)).ClearContents
        Sh.Range("A2").Resize(K, UBound(Arr, 2)).Value = dArr
        Workbooks(fil.Name).Close True
        OldName = ChonO.GetAbsolutePathName(fil)
        NewName = Path & MH & " (" & " " & Format(DateF, "dd-MMM") & ")." & TyName
        ChonO.MoveFile OldName, NewName
    End If
End If
Next fil
End If
Next J
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Nói túm lại, bạn tìm giải pháp khác như tôi nói ở mục 1. còn VBA thì thua rồi…-\/.

www.giaiphapexcel.com/diendan/threads/copy-d%E1%BB%AF-li%E1%BB%87u-v%C3%A0o-file-%C4%91ang-%C4%91%C3%B3ng-c%C3%B3-%C4%91i%E1%BB%81u-ki%E1%BB%87n.112703/