Copy dữ liệu vào file đang đóng có điều kiện (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
H

hungdiep85

Thành viên thường trực
Tham gia
1/6/09
Bài viết
218
Được thích
23
Giới tính
Nam
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
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
hpkhuong đã viết:
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???
Nhấp chuột vào đây để mở rộng...





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
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
hpkhuong đã viết:
1. Dữ liệu của bạn nhiều vậy chạy VBA thì nó out of memory là đúng rồi.
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...-\\/.
Nhấp chuột vào đây để mở rộng...

cứ khi có ai la làng OUT OF MEMORY là tôi lại nhớ câu chuyện này

http://ttvnol.com/threads/mot-so-mau-chuyen-ve-trang-nguyen-luong-the-vinh.150942/#post-2838804

làm y như phim Tàu , thi triển võ công cũng phải gắn với các điển cố điển tích trong lịch sử . ha ha ha ha
 
Upvote 0
Dạ. giờ em chia dữ liệu ra thành 30 sheet (mổi mã hàng 1 sheet, em để 3 sheet trước). như vậy là dữ liệu chạy nhẹ liền.


Nhưng giờ có chút vấn dề là em cho chạy code ở

Sheet DULIEU1(Code: xoa_het_du_lieu_cu) sau đó tiếp DULIEU2
Sheet DULIEU2(Code: Noi_tiep_du_lieu_DULIEU1) sau đó tiếp DULIEU3
Sheet DULIEU3(Code: Noi_tiep_du_lieu_DULIEU2)


như vậy là em phải từng sheet bấm chạy code và chọn lại folder, có cách nào nối các code lại với nhau và không cần chọn lại folder(chỉ chọn folder lần đầu chạy code ở DULIEU1)

Em cảm ơn
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Mình dùng bản excel 2007 portable nên thử với dữ liệu ít ở bài 3 đã bị lỗi nên không rõ có phải bạn muốn copy tất cả các dòng mã hàng 1,2,3,A,B,C... vào file 1,2,3,A,B,C... không? Nếu đúng vậy để tránh tràn bộ nhớ thì bạn làm như sau:
- Save file dữ liệu nếu cần, mục đích sau này sửa đổi file và thoát ra không lưu thay đổi nữa (có thể copy 1 file dự phòng cho chắc ăn).
- Sort sheet dữ liệu theo cột mã hàng, mình sort thử với dữ liệu lớn mất có 1 phút.
- Copy, paste special value cột B sang sheet trống (ví dụ cột A sheet2). Dùng chức năng remove duplicates để lấy danh sách mã hàng không trùng (cách 1). Nếu danh sách mã hàng là cố định thì bạn có thể lưu luôn vào code rồi ghi vào sheet2 từ A1 đến A30 cho nhanh (cách 2).
- Ô sheet2!B1 bạn nhập công thức =IFERROR(MATCH(A1,DULIEUTONG!B:B,0),0) rồi kéo xuống đủ 30 mã hàng. Như dữ liệu của bạn thì B1=11, B2=24587, B3=49163. Dữ liệu mã hàng 1 sẽ từ dòng 11 đến 24586, mã hàng 2 sẽ từ dòng 24587 đến 49162 trong sheet DULIEUTONG. Nếu cột B có giá trị =0 (điều này có thể xảy ra khi bạn dùng cách 2 ở trên), ví dụ B2=0 thì mã hàng 1 sẽ bắt đầu từ dòng 11 đến dòng 49162 và mã hàng 2 không có dữ liệu.
- Copy các khối dữ liệu này vào file mã hàng tương ứng rồi đóng file mã hàng lại.
- Sau khi copy tất cả mã hàng thì đóng file dữ liệu tổng lại và không lưu thay đổi.
 
Upvote 0
hungdiep85 đã viết:
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
Nhấp chuột vào đây để mở rộng...

Đêm khuya khó ngũ đi cân voi chơi
trước hết ta cần chuẩn bị 1 số đạo cụ
1/file DULIEUTONG . file này bạn cần phải SAVE AS đuôi xlsb nhé .
2/giả lập dữ liệu , mượn sub tạo dữ liệu ảo của anh hpkhuong

hpkhuong đã viết:
Mã: 
Sub CopyGiaLap()
Application.ScreenUpdating = False
Sheet2.Range("B1:BK30").Copy Sheet1.Range("B11:B600010")
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...

3/cái cân để cân con voi . cho em mượn lại code của anh nha anh hpkhuong . hi hi

Mã: 
Public Sub hello()
Dim arr, lr As Long, arrInfo(1 To 10000, 1 To 3), tmp, r As Long, k As Long, mytime As Double
Dim Path, ChonO As Object, ChonF As Object, fil As Object, DateF As Date
Dim ShName As String, TyName As String, sh As Worksheet, OldName As String, NewName As String


mytime = timer
Application.ScreenUpdating = False
DateF = Sheet1.[Q9].Value
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = ""
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    Path = .SelectedItems(1) & "\"
End With
Set ChonO = CreateObject("Scripting.FilesystemObject")
Set ChonF = ChonO.GetFolder(Path)
With Sheet1
    lr = .[B1000000].End(xlUp).Row
    .Range("B11:B" & lr).Resize(, 62).Sort .[B11], xlAscending
    arr = .Range("B11:B" & lr + 1).Value
    For r = 1 To UBound(arr) Step 1
        If arr(r, 1) <> tmp Then
            k = k + 1
            arrInfo(k, 1) = arr(r, 1)
            arrInfo(k, 2) = r + 10
            If k > 1 Then arrInfo(k - 1, 3) = r + 9
            tmp = arr(r, 1)
        End If
    Next
    
    For Each fil In ChonF.Files
        ShName = ChonO.GetBaseName(fil)
        TyName = ChonO.GetExtensionName(fil)
        For r = 1 To k - 1 Step 1
            If Left(ShName, Len(arrInfo(r, 1))) = arrInfo(r, 1) Then
                Set sh = Workbooks.Open(fil.Path, , , , "AAA").Worksheets("DULIEU")
                sh.Range(sh.[A2], sh.UsedRange.SpecialCells(xlCellTypeLastCell).Offset(20)).ClearContents
                .Range("B" & arrInfo(r, 2) & ":B" & arrInfo(r, 3)).Resize(, 62).Copy
                sh.Range("B2").PasteSpecial xlPasteValues
                Workbooks(fil.Name).Close True
                OldName = ChonO.GetAbsolutePathName(fil)
                NewName = Path & arrInfo(r, 1) & " (" & " " & Format(DateF, "dd-MMM") & ")." & TyName
                ChonO.MoveFile OldName, NewName
                Exit For
            End If
        Next
    Next
    Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
MsgBox timer - mytime
ThisWorkbook.Close False
End Sub

nếu hên sẽ không bị lỗi , xui thì ... từ từ bàn lại . hi hi
 
Lần chỉnh sửa cuối:
Upvote 0
Hau151978 đã viết:
Mình dùng bản excel 2007 portable nên thử với dữ liệu ít ở bài 3 đã bị lỗi nên không rõ có phải bạn muốn copy tất cả các dòng mã hàng 1,2,3,A,B,C... vào file 1,2,3,A,B,C... không? Nếu đúng vậy để tránh tràn bộ nhớ thì bạn làm như sau:
- Save file dữ liệu nếu cần, mục đích sau này sửa đổi file và thoát ra không lưu thay đổi nữa (có thể copy 1 file dự phòng cho chắc ăn).
- Sort sheet dữ liệu theo cột mã hàng, mình sort thử với dữ liệu lớn mất có 1 phút.
- Copy, paste special value cột B sang sheet trống (ví dụ cột A sheet2). Dùng chức năng remove duplicates để lấy danh sách mã hàng không trùng (cách 1). Nếu danh sách mã hàng là cố định thì bạn có thể lưu luôn vào code rồi ghi vào sheet2 từ A1 đến A30 cho nhanh (cách 2).
- Ô sheet2!B1 bạn nhập công thức =IFERROR(MATCH(A1,DULIEUTONG!B:B,0),0) rồi kéo xuống đủ 30 mã hàng. Như dữ liệu của bạn thì B1=11, B2=24587, B3=49163. Dữ liệu mã hàng 1 sẽ từ dòng 11 đến 24586, mã hàng 2 sẽ từ dòng 24587 đến 49162 trong sheet DULIEUTONG. Nếu cột B có giá trị =0 (điều này có thể xảy ra khi bạn dùng cách 2 ở trên), ví dụ B2=0 thì mã hàng 1 sẽ bắt đầu từ dòng 11 đến dòng 49162 và mã hàng 2 không có dữ liệu.
- Copy các khối dữ liệu này vào file mã hàng tương ứng rồi đóng file mã hàng lại.
- Sau khi copy tất cả mã hàng thì đóng file dữ liệu tổng lại và không lưu thay đổi.
Nhấp chuột vào đây để mở rộng...



không biết sao em zip file ở bài #6 bị lổi , file gốc em để ở công ty , em có làm theo cách anh, nhưng chưa hiểu lắm , để mai em vô công ty lấy file gốc làm thử.


em cảm ơn anh trước
 
Upvote 0
doveandrose đã viết:
Đêm khuya khó ngũ đi cân voi chơi
trước hết ta cần chuẩn bị 1 số đạo cụ
1/file DULIEUTONG . file này bạn cần phải SAVE AS đuôi xlsb nhé .
2/giả lập dữ liệu , mượn sub tạo dữ liệu ảo của anh hpkhuong



3/cái cân để cân con voi . cho em mượn lại code của anh nha anh hpkhuong . hi hi

Mã: 
Public Sub hello()
Dim arr, lr As Long, arrInfo(1 To 10000, 1 To 3), tmp, r As Long, k As Long, mytime As Double
Dim Path, ChonO As Object, ChonF As Object, fil As Object, DateF As Date
Dim ShName As String, TyName As String, sh As Worksheet, OldName As String, NewName As String


mytime = timer
Application.ScreenUpdating = False
DateF = Sheet1.[Q9].Value
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = ""
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    Path = .SelectedItems(1) & "\"
End With
Set ChonO = CreateObject("Scripting.FilesystemObject")
Set ChonF = ChonO.GetFolder(Path)
With Sheet1
    lr = .[B1000000].End(xlUp).Row
    .Range("B11:B" & lr).Resize(, 62).Sort .[B11], xlAscending
    arr = .Range("B11:B" & lr + 1).Value
    For r = 1 To UBound(arr) Step 1
        If arr(r, 1) <> tmp Then
            k = k + 1
            arrInfo(k, 1) = arr(r, 1)
            arrInfo(k, 2) = r + 10
            If k > 1 Then arrInfo(k - 1, 3) = r + 9
            tmp = arr(r, 1)
        End If
    Next
    
    For Each fil In ChonF.Files
        ShName = ChonO.GetBaseName(fil)
        TyName = ChonO.GetExtensionName(fil)
        For r = 1 To k - 1 Step 1
            If Left(ShName, Len(arrInfo(r, 1))) = arrInfo(r, 1) Then
                Set sh = Workbooks.Open(fil.Path, , , , "AAA").Worksheets("DULIEU")
                sh.Range(sh.[A2], sh.UsedRange.SpecialCells(xlCellTypeLastCell).Offset(20)).ClearContents
                .Range("B" & arrInfo(r, 2) & ":B" & arrInfo(r, 3)).Resize(, 62).Copy
                sh.Range("B2").PasteSpecial xlPasteValues
                Workbooks(fil.Name).Close True
                OldName = ChonO.GetAbsolutePathName(fil)
                NewName = Path & arrInfo(r, 1) & " (" & " " & Format(DateF, "dd-MMM") & ")." & TyName
                ChonO.MoveFile OldName, NewName
                Exit For
            End If
        Next
    Next
    Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
MsgBox timer - mytime
ThisWorkbook.Close False
End Sub

nếu hên sẽ không bị lỗi , xui thì ... từ từ bàn lại . hi hi
Nhấp chuột vào đây để mở rộng...




HÊN rồi Anh ơi , sáng mai em vô công ty cho chạy thử hàng liền.


Em Cảm Ơn Anh
 
Upvote 0
doveandrose đã viết:
Đêm khuya khó ngũ đi cân voi chơi
trước hết ta cần chuẩn bị 1 số đạo cụ
1/file DULIEUTONG . file này bạn cần phải SAVE AS đuôi xlsb nhé .
2/giả lập dữ liệu , mượn sub tạo dữ liệu ảo của anh hpkhuong



3/cái cân để cân con voi . cho em mượn lại code của anh nha anh hpkhuong . hi hi

Mã: 
Public Sub hello()
Dim arr, lr As Long, arrInfo(1 To 10000, 1 To 3), tmp, r As Long, k As Long, mytime As Double
Dim Path, ChonO As Object, ChonF As Object, fil As Object, DateF As Date
Dim ShName As String, TyName As String, sh As Worksheet, OldName As String, NewName As String


mytime = timer
Application.ScreenUpdating = False
DateF = Sheet1.[Q9].Value
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = ""
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    Path = .SelectedItems(1) & "\"
End With
Set ChonO = CreateObject("Scripting.FilesystemObject")
Set ChonF = ChonO.GetFolder(Path)
With Sheet1
    lr = .[B1000000].End(xlUp).Row
    .Range("B11:B" & lr).Resize(, 62).Sort .[B11], xlAscending
    arr = .Range("B11:B" & lr + 1).Value
    For r = 1 To UBound(arr) Step 1
        If arr(r, 1) <> tmp Then
            k = k + 1
            arrInfo(k, 1) = arr(r, 1)
            arrInfo(k, 2) = r + 10
            If k > 1 Then arrInfo(k - 1, 3) = r + 9
            tmp = arr(r, 1)
        End If
    Next
    
    For Each fil In ChonF.Files
        ShName = ChonO.GetBaseName(fil)
        TyName = ChonO.GetExtensionName(fil)
        For r = 1 To k - 1 Step 1
            If Left(ShName, Len(arrInfo(r, 1))) = arrInfo(r, 1) Then
                Set sh = Workbooks.Open(fil.Path, , , , "AAA").Worksheets("DULIEU")
                sh.Range(sh.[A2], sh.UsedRange.SpecialCells(xlCellTypeLastCell).Offset(20)).ClearContents
                .Range("B" & arrInfo(r, 2) & ":B" & arrInfo(r, 3)).Resize(, 62).Copy
                sh.Range("B2").PasteSpecial xlPasteValues
                Workbooks(fil.Name).Close True
                OldName = ChonO.GetAbsolutePathName(fil)
                NewName = Path & arrInfo(r, 1) & " (" & " " & Format(DateF, "dd-MMM") & ")." & TyName
                ChonO.MoveFile OldName, NewName
                Exit For
            End If
        Next
    Next
    Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
MsgBox timer - mytime
ThisWorkbook.Close False
End Sub

nếu hên sẽ không bị lỗi , xui thì ... từ từ bàn lại . hi hi
Nhấp chuột vào đây để mở rộng...





Dạ , Em đả cho chạy thử từ thứ 2 đến giờ và code không còn báo lổi nào nữa, Em cảm ơn Anh và các Anh Chị trên GPE rất nhiều à.
 
Upvote 1
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

P
  • Question Question
Lấy giá trị duy nhất nhiều cột khác nhau (1 người xem)
Trả lời
5
Đọc
147
phamgiang90
P
Q
Phát tiếng khi code chạy ra giá trị yêu cầu (3 người xem)
    • Cười
Trả lời
1
Đọc
67
DeTong
D
T
  • Question Question
Xin thầy/cô và anh chị giúp đỡ cách điền thông tin ca kíp trực trong bảng Excel bằng VBA (2 người xem)
Trả lời
1
Đọc
68
HUONGHCKT
H
GPE-Trợ Lý
  • Đã khóa
[GPE] TALK SHOW ĐỊNH KỲ (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
3
Đọc
917
GPE-Trợ Lý
GPE-Trợ Lý
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365 (15 người xem)
    • Thích
Trả lời
2
Đọc
3K
GPE-Trợ Lý
GPE-Trợ Lý
HeSanbi
Office Tool Plus - Ứng dụng tải, cài đặt, gỡ bỏ, nhập khóa, xóa khóa bản quyền Office nhanh chóng (1 người xem)
    • Thích
Trả lời
8
Đọc
351
HeSanbi
HeSanbi
A
  • Question Question
Em nhờ anh/chị/em/chú/bác giúp em viết code tổng hợp dữ liệu. em tính công thức nó nặng quá. em cám ơn
Trả lời
12
Đọc
265
pycckuu410
pycckuu410
C
Lọc chỉ tiêu sheet 1, kết quả tự động ở các sheet còn lại
Trả lời
7
Đọc
97
thuytrangbp28
T
D
Tính số lượng nhập vào điều kiện với các code ở thời điểm hiện tại.
Trả lời
0
Đọc
25
doanlong49
D
HeSanbi
  • Đã giải quyết
WeatherXL - Ứng dụng lấy dữ liệu Thời tiết siêu nhanh (*15/01/2024) (1 người xem)
    • Thích
    • Yêu thích
3 4 5
Trả lời
89
Đọc
19K
thuong hau
T
T
Cần hỏi về bảng Table (1 người xem)
Trả lời
3
Đọc
56
trungdtbidi
T
Nguyễn Duy Tuân
Lập trình VBA với Google Drive, OneDrive, DropBox cho Upload-Download-Copy-Move...
    • Cảm ơn
Trả lời
3
Đọc
221
Nguyễn Duy Tuân
Nguyễn Duy Tuân
4
EXCEL TỰ ĐỘNG MỞ TRÊN WEB
Trả lời
8
Đọc
206
HeSanbi
HeSanbi
N
Công thức tính điền số lượng lũy kế giao hàng theo điều kiện
Trả lời
0
Đọc
41
Ngocminh19
N
A
Xin các bác chỉ giúp cách thống kê danh sách học sinh
Trả lời
6
Đọc
123
Anhnn9
A
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
7
Đọc
294
Việt Nguyễn 86
Việt Nguyễn 86
cadafi
Hướng dẫn tạo Macro chuyển số thành chữ trong Open Office 3.1 (Tiếng Việt Unicode)
Trả lời
11
Đọc
25K
minnad123
M
T
hỏi về đếm số ngày doanh thu tăng và giảm
Trả lời
5
Đọc
85
VetMini
V
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
12 13 14
Trả lời
263
Đọc
28K
ongke0711
ongke0711
T
xin công thức tính được số người còn lại theo từng cột
Trả lời
1
Đọc
64
bebo021999
B
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom