Lấy dữ liệu từ file excel đang đóng, sang file excel đang mở bằng ADODB (ADO)! (1 người xem)

Liên hệ QC

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

Thư Sinh Áo Trắng

Thành viên hoạt động
Tham gia
26/3/21
Bài viết
160
Được thích
31
- Em xin nhờ các anh chị giúp đỡ lấy dữ liệu file excel đang đóng sang file excel đang mở bằng VBA xử dụng ADODB (ADO)
- Em có ngồi kiếm code đễ sửa chữa nhưng đa số code mở lên 1 bảng chọn file, hoặc copy địa chỉ cố định. Hai vấn đề này khiến em không thể sửa code trên mạng để dùng được
- Vì:
+ Dữ liệu em là cập nhật mới, tức là chỉ số dòng luôn tăng lên sau mỗi lần cần lấy dữ liệu => copy địa chỉ cố định là em chết rồi
+ Mỗi lần dùng code, code bắt chọn file, nếu có 600 file thì tức là 600 lần chọn => vậy em cũng chết rồi
- Xin giúp đỡ code VBA xử dụng ADO để lấy dữ liệu file đang đóng sang file đang mở, không bắt chọn file, copy(ghi) được vùng có chỉ số động( luôn tăng)
1111111111111.jpg
Em chân thành cảm ơn! Và mong được sự giúp đỡ!
(file đính kèm dang_dong, dang_mo)
 

File đính kèm

- Xin giúp đỡ code VBA xử dụng ADO để lấy dữ liệu file đang đóng sang file đang mở, không bắt chọn file, copy(ghi) được vùng có chỉ số động( luôn tăng)
Bạn thử code này coi
Mã:
Sub GPE()
  Dim cn As Object, rs As Object
  Dim eRow&, includeList$, excludeList$, Sql$
  With Sheet1
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 2 Then .Range("A2:C" & eRow).Clear
  End With
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "All Excel", "*.xls*"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count < 1 Then MsgBox ("Ban khong chon file nao"): Exit Sub
    If .SelectedItems.Count Then
    
      On Error Resume Next
      Set cn = CreateObject("adodb.connection")
      cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(1) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
      Sql = "SELECT * FROM [$A2:C] WHERE f1 is not Null"
      Set rs = cn.Execute(Sql)
      If Not rs.EOF Then Sheet1.Range("A2").CopyFromRecordset rs
      rs.Close:      cn.Close
      Set rs = Nothing: Set cn = Nothing
      On Error GoTo 0
    End If
  End With
End Sub
 
Upvote 0
Không lẽ mỗi file lại lẻ tẻ hơn ngàn dòng thôi sao.
Hihi. Không thấy chủ top vào nói gì nhỉ. Chứ thực sự em cũng không nghĩ là dữ liệu nó sử dụng tới hơn triệu dòng. Còn nếu mà thực sự nhiều dữ liệu thế thì chắc dùng cách khác có lẽ hay hơn.
 
Upvote 0
Hihi. Có lẽ như bác ở trên nói. Tới tận 600 file thì nhiều lắm nhỉ.
Nhìn lại thấy nick cậu "Thư sinh áo trắng" này, theo cậu này mấy topic thì biết đang nghiên cứu tiền ảo hay Bitcoin gì đó, nhưng ngại không dám đưa dữ liệu thật, hỏi hết cái này sang cái khác.
Tạm đoán việc @Thư Sinh Áo Trắng đang làm do vậy có mấy ý như này:
1. Bitcoin có ý nghĩa thật sự chứ không phải chỉ hư danh là tiền ảo, công nghệ Blockchain của BTC có ý nghĩa thật trong cuộc sống, chỉ là người ta đang lạm dụng và bơm giá thôi.
2. Việc lấy dữ liệu thô có nhiều trang web cho phép lấy giữ liệu giá cũ (đã qua) nó có thể nhẹ nhàng hơn nhiều so với cách cậu đang làm.
3. Muốn giao dịch thì phải có phương pháp, và phải có hiệu quả, một rừng dữ liệu thô không được liên kết thì kg có ý nghĩa gì cả.
4. Nếu việc đang làm dễ dàng như vậy thì chắc hẳn các nhà toán học, coder, ... chắc giàu dữ lắm.
---------
Hy vọng mình đoán sai :)
 
Lần chỉnh sửa cuối:
Upvote 0
Em cảm ơn các bác đã đã chia sẻ.
Thực tế là em cũng phải thử hết cái này đến cái khác xem nó ra làm sao? Vì sao mà phải nhiều máy phần cứng khủng chỉ để giải thuật toán?
Bài đã được tự động gộp:

Hihi. Không thấy chủ top vào nói gì nhỉ. Chứ thực sự em cũng không nghĩ là dữ liệu nó sử dụng tới hơn triệu dòng. Còn nếu mà thực sự nhiều dữ liệu thế thì chắc dùng cách khác có lẽ hay hơn.
Sơ sơ 1 sheets em đang xử dụng tới 20 triệu cell và 1 file nặng tầm 200 mê.
Vì file nặng phải chia tách nhỏ ra để chạy code không đơ.
Phương châm em giờ. Code chạy không đơ quá 15 phút là đc.
Do chia tách nhiều nên nhiều file ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
File này có đủ chỗ cho dữ liệu của 600 file không bạn nhỉ?
Phải dùng nhiều sub và func để thu nhỏ hoặc dàn ra nhiều cột. Nhưng làm sao file vba không thôi tầm 200 mê thì chạy code còn kiên nhẫn đc, nếu quá 200 mê/ file thì chia nhỏ file ra nữa và có thể cả 1000 file ạ
 
Upvote 0
Phải dùng nhiều sub và func để thu nhỏ hoặc dàn ra nhiều cột. Nhưng làm sao file vba không thôi tầm 200 mê thì chạy code còn kiên nhẫn đc, nếu quá 200 mê/ file thì chia nhỏ file ra nữa và có thể cả 1000 file ạ
Mình biết có người đầu tư rất nhiều máy, một tháng nhiều triệu tiền điện, bây giờ đang đi bán hàng thuê để trả nợ dần.
 
Lần chỉnh sửa cuối:
Upvote 0
Em cảm ơn các bác đã đã chia sẻ.
Thực tế là em cũng phải thử hết cái này đến cái khác xem nó ra làm sao? Vì sao mà phải nhiều máy phần cứng khủng chỉ để giải thuật toán?
Bài đã được tự động gộp:


Sơ sơ 1 sheets em đang xử dụng tới 20 triệu cell và 1 file nặng tầm 200 mê.
Vì file nặng phải chia tách nhỏ ra để chạy code không đơ.
Phương châm em giờ. Code chạy không đơ quá 15 phút là đc.
Do chia tách nhiều nên nhiều file ạ.
Nghiên cứu lĩnh vực gì vậy, bình thường ít khi lưu dữ liệu tới 20 triệu cell, những kết quả xử lý không nên lưu trong file.
Dữ liệu nhiều nên chuyển sang các phần mềm quản trị dữ liệu hoặc lưu dưới dạng file text
 
Upvote 0
Nghiên cứu lĩnh vực gì vậy, bình thường ít khi lưu dữ liệu tới 20 triệu cell, những kết quả xử lý không nên lưu trong file.
Dữ liệu nhiều nên chuyển sang các phần mềm quản trị dữ liệu hoặc lưu dưới dạng file text
Em tập tành xây một số đường hồi quy.
Vì excel em coi là cái gốc mọi lập trình khác, em mới nhập môn nên cũng chưa nghĩ tới ngôn ngữ hay phần mềm khác ạ.
Hiện cách chia thành nhiều file, 1 máy và nhiều Sub/Func thì thu nhỏ hay phóng to dữ liệu vẫn ổn anh ạ.
Anh có thể giởi thiệu qua phần mềm và lưu file dạng text thì có tính toán đc như VBA không ạ?
 
Upvote 0
Bạn thử code này coi
Sub GPE()
Code chạy tốt anh ạ! Em cảm ơn anh cho em code!
-Nhờ anh và các anh nâng cấp nên một chút, chỗ
PHP:
...........
With Application.FileDialog(msoFileDialogFilePicker) <----- Chỗ này em muốn là đường dẫn đến file cố định một file->1 Sheet->1 vùng cần ghi, không phải pick chọn file ạ!
............
Tức là em bỏ qua phần Pick chọn file ạ! Mà là đường dẫn cụ thể ạ!
- Bỏ qua bẫy lỗi, và không hiện thông báo: Khi cung cấp đúng địa chỉ(đường dẫn file đóng) cần ghi dữ liệu thì ông Code phải làm chuẩn đưa nó về file mở cho Em. Nghĩa là chạy code là phải lấy được giữ liệu ở file đóng mà code không kêu ca gì(nhưng phải chuẩn). Nôm na là giấy trắng mực đen không thể có chuyện lỗi được hoặc ràng buộc để không để ra lỗi cho quá trình ghi và dán
- Giữ nguyên định dạng hiện thị ở file đóng khi copy sang file mở(file thực thi có code VBA)
Em chân thành cảm ơn anh @buiquangthuan
 
Upvote 0
Em tập tành xây một số đường hồi quy.
Vì excel em coi là cái gốc mọi lập trình khác, em mới nhập môn nên cũng chưa nghĩ tới ngôn ngữ hay phần mềm khác ạ.
Hiện cách chia thành nhiều file, 1 máy và nhiều Sub/Func thì thu nhỏ hay phóng to dữ liệu vẫn ổn anh ạ.
Anh có thể giởi thiệu qua phần mềm và lưu file dạng text thì có tính toán đc như VBA không ạ?
Phần mềm Excel
Đọc file text: https://www.giaiphapexcel.com/diendan/threads/bài-12-filesystemobject.129399/
Lưu theo dạng text: Tìm trên diễn đàn
 
Upvote 0
Phải dùng nhiều sub và func để thu nhỏ hoặc dàn ra nhiều cột. Nhưng làm sao file vba không thôi tầm 200 mê thì chạy code còn kiên nhẫn đc, nếu quá 200 mê/ file thì chia nhỏ file ra nữa và có thể cả 1000 file ạ

Dữ liệu đầu vào nên là file .CSV cho nhẹ nhàng, bỏ hết các định dạng, công thức...không cần thiết. Tôi thấy dữ liệu từ sàn thường được lưu về dưới dạng .csv hoặc dùng ứng dụng (python api) cũng lấy dữ liệu về xử lý cũng ở dạng .csv
 
Upvote 0
Dữ liệu đầu vào nên là file .CSV cho nhẹ nhàng, bỏ hết các định dạng, công thức...không cần thiết. Tôi thấy dữ liệu từ sàn thường được lưu về dưới dạng .csv hoặc dùng ứng dụng (python api) cũng lấy dữ liệu về xử lý cũng ở dạng .csv
Nếu được là CSV thì ngwoif ta dùng Powershell append đống files lại với nhau rồi hãy import. Làm việc tới mức độ nhiều files thế này thì bắt buộc phải biết Powershell. Nếu muốn lâu dài hơn thì phải học qua kỹ thuật CSDL Phân Vùng (partitioned database)

Thớt này làm việc với dữ liệu hàng khủng của hàng khủng mà không chịu cập nhật kiến thức rồi cứ ngồi đấy than "em chết rồi", "em cũng chết rồi". Nếu cái cơ quan này cứ mãi dùng thớt ở công việc này thì chính cơ quan cũng đang dãy chết.

Hàng khủng của hàng khủng này chỉ có dân chuyên nghiệp về Data Migration mới quản lý nổi.
Về nghề Data thì người này tối thiểu phải trên bậc tôi.
Tôi nghĩ là cỡ SQL Server bản chính trở lên chứ SQL Server Express cũng sụm.

Chú: số files nhiều thì phân nhóm chúng thành nhiều thư mục. 1000 files phân ra vài chục nhóm chỉ mất chừng 1 giờ đòng hồ là tối đa. Hình như các cô cậu công tử tiểu thơ ngày nay cứ tưởng tượng làm viiệc kéo chuột 1 giờ là "gãy tay", "em chết mất". Trong khi ngược lại, chơi ghêm cả buổi chả sao hết. Người không quen như tôi nhìn cái ghêm 20 phút là tối cả mặt mũi. Suy ra, chỉ là thói quen thôi. Kéo chuột cho công việc vài phút là mỏi tay, bấm ghêm càng lâu càng khoái?
 
Upvote 0
Thấy có nhiều ý hay ... Tôi gợi ý cho 1 cách ... còn thực hiện hay ko thì tùy

1/ tạo 1 CSDL SQLite ( File *.sqlite, *.db +...) 1 File cở sở dữ liệu SQLite cho lưu tối đa 2048 GB và chạy đa nền tảng
2/ VD: những cái gì mà ko phải tạo mối quan hệ tính toán như DataXuat , DataNhap ... lưu vào đó
3/ khi cần truy xuất cực nhanh ... hãy hình dung nó cho lưu với cái Data khủng đó
4/ Nhưng cái gì cần tính toán linh tinh thì lưu vào Files *.accdb ( Access ) ... làm gì đó tùy
....
....
Sử dụng SQLite
1/ để sử dụng được SQLite trên Windows các bản sau này có sẳn thư viện API cứ thế khai báo mà xài .... rất khó
2/ cài Driver của nó xong dùng ADODB của Ms cứ thế kết nối mà xài .... rất đơn giản như xài trên VBA vậy
3/ nếu ko thích 2 mục trên thì có thể tự tay viết lấy 1 DLL mà sử dụng ... VD: VB6 họ cũng viết ok .... Delphi thì quá ok hơn VB6
....
...
Hiện tại tôi đang viết 1 Hàm duy nhất có thể truy xuất được dữ liệu Access , Excel, SQLite chung vào 1 Hàm ( tạm keo SQL Builder ) vì thấy nhiều ttrang trên Quốc tế họ sẻ sử dụng CSDL là SQLite phổ biến trong thời gian tới

...
...
hãy hình dung 1 chút
1/ 1 File Excel nếu lưu khoãng 15MB ... thì cái gì sẻ xảy ra
2/ 1 File Access tối đa = 2GB
3/ SQL Server Ms Free = 10 GB
4/ SQL Server Ms trả phí = ko giới hạn = Tiền ??? = mang qua máy Khác = ?? qua OS = ? qua Linux = ?
....
Tạm nói sơ bộ vậy ... có hứng nói tiếp .... ko thì Run
 
Lần chỉnh sửa cuối:
Upvote 0
Thấy có nhiều ý hay ... Tôi gợi ý cho 1 cách ... còn thực hiện hay ko thì tùy

1/ tạo 1 CSDL SQLite ( File *.sqlite, *.db +...) 1 File cở sở dữ liệu SQLite cho lưu tối đa 2048 GB và chạy đa nền tảng
2/ VD: những cái gì mà ko phải tạo mối quan hệ tính toán như DataXuat , DataNhap ... lưu vào đó
3/ khi cần truy xuất cực nhanh ... hãy hình dung nó cho lưu với cái Data khủng đó
4/ Nhưng cái gì cần tính toán linh tinh thì lưu vào Files *.accdb ( Access ) ... làm gì đó tùy
....
....
Sử dụng SQLite
1/ để sử dụng được SQLite trên Windows các bản sau này có sẳn thư viện API cứ thế khai báo mà xài .... rất khó
2/ cài Driver của nó xong dùng ADODB của Ms cứ thế kết nối mà xài .... rất đơn giản như xài trên VBA vậy
3/ nếu ko thích 2 mục trên thì có thể tự tay viết lấy 1 DLL mà sử dụng ... VD: VB6 họ cũng viết ok .... Delphi thì quá ok hơn VB6
....
...
Hiện tại tôi đang viết 1 Hàm duy nhất có thể truy xuất được dữ liệu Access , Excel, SQLite chung vào 1 Hàm ( tạm keo SQL Builder ) vì thấy nhiều ttrang trên Quốc tế họ sẻ sử dụng CSDL là SQLite phổ biến trong thời gian tới

...
...
hãy hình dung 1 chút
1/ 1 File Excel nếu lưu khoãng 15MB ... thì cái gì sẻ xảy ra
2/ 1 File Access tối đa = 2GB
3/ SQL Server Ms Free = 10 GB
4/ SQL Server Ms trả phí = ko giới hạn = Tiền ??? = mang qua máy Khác = ?? qua OS = ? qua Linux = ?
....
Tạm nói sơ bộ vậy ... có hứng nói tiếp .... ko thì Run
Dạ! Có ạ!
Đúng là file vba nặng tầm 15 mê đã thấy chậm chậm rồi bác ạ. Mà em toàn phải lưu file nặng tầm 200 mê.
Mỗi lần chạy lại " Not respending" đau kinh khủng.
Những gì bài 16,17,18 đều là cái đề cương của chuyên gia chia sẻ đáng quý ạ
Anh nói tiếp đi ạ!
 
Upvote 0
Em cảm ơn các bác đã đã chia sẻ.
Thực tế là em cũng phải thử hết cái này đến cái khác xem nó ra làm sao? Vì sao mà phải nhiều máy phần cứng khủng chỉ để giải thuật toán?
Bài đã được tự động gộp:


Sơ sơ 1 sheets em đang xử dụng tới 20 triệu cell và 1 file nặng tầm 200 mê.
Vì file nặng phải chia tách nhỏ ra để chạy code không đơ.
Phương châm em giờ. Code chạy không đơ quá 15 phút là đc.
Do chia tách nhiều nên nhiều file ạ.
20 triệu cell thì nó bao nhiêu dòng và bao nhiêu cột vậy bạn?
 
Upvote 0
20 triệu cell thì nó bao nhiêu dòng và bao nhiêu cột vậy bạn?
Dạ! Khoảng 15 cái bảng 500.000 x 3 cột ( năm trăm nghìn dòng), với 15 cái bảng cỡ 100.000( môt trăng nghìn dòng) x 3 cột. Em cũng chưa kéo được đến cuối bảng, để xem sao? Do nó lệch dòng các bảng với nhau để kéo xem từng bảng cũng Not ResPending luôn ấy ạ! Còn chạy code thì đau tim lắm! hic hic
Giờ tính lại hóa ra tầm gần 30 triệu Cell/ 1 Sheet ạ!
Và khoảng 600 đến 1000 file như vậy!
Do file quá nặng phải chia tách ra để chạy code VBA, ví nó hay bị Not Respending khổ lắm anh ạ! Do chưa thể cập nhật công nghệ mới nên chơi kiểu phóng to thu nhỏ dữ liệu rồi tính toán ạ!
Thành ra nó nảy sinh mấy chủ đề của em mấy nay ạ!
Chỉnh em code bài 2 với! Em muốn nó là đường dẫn cố định không phải chọn file!
Cảm ơn anh
 
Lần chỉnh sửa cuối:
Upvote 0
Ơi anh @buiquangthuan @snow25 @Maika8008 @HieuCD @phuocam
- Ở bài 2: anh @buiquangthuan cho code chạy ứng với trường hợp lấy dữ liệu một vùng của một sheet trong file đóng
- Và ở bài 21 này. Em có nhu cầu lấy dữ liệu một vùng của nhiều Sheet trong file đang đóng. Mô tả như sau:
nhieu.jpg
- Code em chế từ code anh @buiquangthuan như sau:
PHP:
Sub Get_data_from_multiple_sheets()
Dim cn As Object, rs As Object, sRAddress
Dim eRow&, includeList$, excludeList$, Sql$, shName, CopyAddress, PateAddress, lRAddress, ClearAddress
shName = Array("sh1", "sh2", "sh3")
CopyAddress = Array("$A2:A", "$A2:A", "$A2:A")
PateAddress = Array("A2", "B2", "C2")
lRAddress = Array("A", "B", "C")
ClearAddress = Array("A2:A", "B2:B", "C2:C")
For chon = 0 To 2
    With Sheets("dich")
        eRow = .Range(lRAddress(chon) & Rows.Count).End(xlUp).Row
        If eRow > 2 Then .Range(ClearAddress(chon) & eRow).Clear
    End With
Next chon
    With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "All Excel", "*.xls*"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count < 1 Then MsgBox ("Ban khong chon file nao"): Exit Sub
    If .SelectedItems.Count Then
    On Error Resume Next
    Set cn = CreateObject("adodb.connection")
        cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(1) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
        For chon = 0 To 2
            Sql = "SELECT * FROM [" & shName(chon) & "CopyAddress(chon)] WHERE f1 is not Null" '<---chưa hiểu f1,f2...f9 là gì,chỉ giúp em với nhé!
            Set rs = cn.Execute(Sql)
                If Not rs.EOF Then
                    Sheets("dich").Range(PateAddress(chon)).CopyFromRecordset rs
                End If
        Next chon
        rs.Close:      cn.Close
        Set rs = Nothing: Set cn = Nothing
    On Error GoTo 0
    End If
    End With
End Sub
- Code bài 2 chạy tốt. Mỗi một Sheet của file đóng ta chạy một Sub.
- Các bác giúp em chỉnh code cho phép ghi dữ liệu nhiều sheet của file đóng -> sang file đang mở với ạ! Em chân thành cảm ơn!
(có file đính kèm)
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Đây là code nhờ bác @Maika8008 sửa lại code bài 2 của bác @buiquangthuan ,được code mới trong trường hợp không muốn pick file mà dùng đường dẫn cố định.
PHP:
Sub lay_data_file_dong_sang_file_mo_Maika8008()
Dim cn As Object, rs As Object, strPath As String
Dim eRow&, includeList$, excludeList$, Sql$
With Sheet1
eRow = .Range("A" & Rows.Count).End(xlUp).Row
If eRow > 2 Then .Range("A2:C" & eRow).Clear
End With
strPath = ThisWorkbook.Path & "\" & "dang_dong.xlsm" 'Duong dan co dinh
On Error Resume Next
Set cn = CreateObject("adodb.connection")
cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & strPath & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
Sql = "SELECT * FROM [$A2:C] WHERE f1 is not Null"
Set rs = cn.Execute(Sql)
If Not rs.EOF Then Sheet1.Range("A2").CopyFromRecordset rs
rs.Close: cn.Close
Set rs = Nothing: Set cn = Nothing
On Error GoTo 0
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Bài #22 chưa có lời giải à bạn?
Dạ chưa ạ! Em chạy xong không thấy lỗi, không có gì được ghi ra.
- Giờ có code fix sự kiện pick file thành đường dẫn cố định rồi. Chiều tối về chế ra 2 trường hợp nữa mong rằng cho đứt đuôi con nòng nọc top ADO này!
- Như ở trên:
+ Bài 2 của anh @buiquangthuan code lấy dữ liệu file đòng sang file đang mở, mỗi lần chạy phải pick chọn file
+ Bài 23 của bác @Maika8008 code lấy dữ liệu file đang đóng sang file mở, không phải pick chọn file (đường dẫn cố định)
+ Bài 22 lấy dữ liệu từ nhiều sheet của file đang đóng sang file đang mở, không phải pick chọn file nhưng chưa chạy được. Nhờ bác @Maika8008 giúp em bài này với em có đính kèm file ở bài 22 đấy bác!
+ Bài dự kiến sẽ đăng hỏi: lấy dữ liệu nhiều file đang đóng, trong mỗi file đang đong lại lấy một vài Sheet khác nhau về file đang mở, mà không cần pick chọn!
Nếu được bác để ý đến chắc chắn là xong. Bác giúp em với nhé!
 
Lần chỉnh sửa cuối:
Upvote 0
Dạ chưa ạ! Em chạy xong không thấy lỗi, không có gì được ghi ra.
- Giờ có code fix sự kiện pick file thành đường dẫn cố định rồi. Chiều tối về chế ra 2 trường hợp nữa mong rằng cho đứt đuôi con nòng nọc top ADO này!
- Như ở trên:
+ Bài 2 của anh @buiquangthuan code lấy dữ liệu file đòng sang file đang mở, mỗi lần chạy phải pick chọn file
+ Bài 23 của bác @Maika8008 code lấy dữ liệu file đang đóng sang file mở, không phải pick chọn file (đường dẫn cố định)
+ Bài 22 lấy dữ liệu từ nhiều sheet của file đang đóng sang file đang mở, không phải pick chọn file nhưng chưa chạy được. Nhờ bác @Maika8008 giúp em bài này với em có đính kèm file ở bài 22 đấy bác!
+ Bài dự kiến sẽ đăng hỏi: lấy dữ liệu nhiều file đang đóng, trong mỗi file đang đong lại lấy một vài Sheet khác nhau về file đang mở, mà không cần pick chọn!
Nếu được bác để ý đến chắc chắn là xong. Bác giúp em với nhé!
File của bạn thì sửa strSh = "Sheet" & i thành "Sh" & i
Tôi sửa code bên dưới cũng được nhưng bạn sửa để hiểu thêm 1 chút.

Rich (BB code):
Sub LayNhieuSheet2()
Dim Rec As Object
Dim strPath As String, strSh As String, i As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Sheet1.Range("A2:C5000").ClearContents
    strPath = ThisWorkbook.Path & "\" & "dang_dong.xlsm"    'Duong dan co dinh
    Dim cnn As String
    cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""Excel 12.0 Xml;HDR=No"""
    Set Rec = CreateObject("ADODB.Recordset")
    With Rec
        For i = 1 To 3
            strSh = "Sheet" & i
            .Open ("Select * From [" & strSh & "$A2:A5000] "), cnn
            Sheet1.Cells(2, i).CopyFromRecordset .DataSource
            .Close
        Next
    End With
    Set Rec = Nothing
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Xong!"
End Sub
 
Upvote 0
File của bạn thì sửa strSh = "Sheet" & i thành "Sh" & i
Tôi sửa code bên dưới cũng được nhưng bạn sửa để hiểu thêm 1 chút.
Cảm ơn bác nhìn code bài 22 không biết em làm gì mà thấy gớm!
- Bạn giúp cho em bài nữa với ạ!
2.jpg1.jpg
Có 2 file đang đóng muốn lấy dữ liệu từ 2 file đang dóng về file đang mở. Nhờ bác @Maika8008 và các bác giúp em với!
 

File đính kèm

Upvote 0
Code cho bài #27
Rich (BB code):
Sub LayNhieuSheet1()
Dim Rec As Object
Dim strPath1 As String, strPath2 As String, i As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Sheet1.Range("A2:C5000").ClearContents
    strPath1 = ThisWorkbook.Path & "\" & "dang_dong_2.xlsm"    'Duong dan co dinh
    strPath2 = ThisWorkbook.Path & "\" & "dang_dong_1.xlsm"    'Duong dan co dinh
    Dim cnn As String, cnn2 As String
    cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath1 & ";Extended Properties=""Excel 12.0 Xml;HDR=No"""
    cnn2 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath2 & ";Extended Properties=""Excel 12.0 Xml;HDR=No"""
    Set Rec = CreateObject("ADODB.Recordset")
    With Rec
        .Open ("Select * From [Date$A2:A5000] "), cnn
        Sheet1.Range("A2").CopyFromRecordset .DataSource
        .Close
        .Open ("Select * From [Time$A2:A5000] WHERE f1 is not Null"), cnn
        Sheet1.Range("B2").CopyFromRecordset .DataSource
        .Close
        .Open ("Select * From [Value$A2:A5000] WHERE f1 is not Null"), cnn
        Sheet1.Range("C2").CopyFromRecordset .DataSource
        .Close
        .Open ("Select * From [Amplitude$A2:B5000] WHERE f1 is not Null"), cnn2
        Sheet1.Range("E2").CopyFromRecordset .DataSource
        .Close
    End With
    Set Rec = Nothing
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Xong!"
End Sub
 
Upvote 0
Code cho bài #27
Rich (BB code):
Sub LayNhieuSheet1()
Dim Rec As Object
Dim strPath1 As String, strPath2 As String, i As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Sheet1.Range("A2:C5000").ClearContents
    strPath1 = ThisWorkbook.Path & "\" & "dang_dong_2.xlsm"    'Duong dan co dinh
    strPath2 = ThisWorkbook.Path & "\" & "dang_dong_1.xlsm"    'Duong dan co dinh
    Dim cnn As String, cnn2 As String
    cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath1 & ";Extended Properties=""Excel 12.0 Xml;HDR=No"""
    cnn2 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath2 & ";Extended Properties=""Excel 12.0 Xml;HDR=No"""
    Set Rec = CreateObject("ADODB.Recordset")
    With Rec
        .Open ("Select * From [Date$A2:A5000] "), cnn
        Sheet1.Range("A2").CopyFromRecordset .DataSource
        .Close
        .Open ("Select * From [Time$A2:A5000] WHERE f1 is not Null"), cnn
        Sheet1.Range("B2").CopyFromRecordset .DataSource
        .Close
        .Open ("Select * From [Value$A2:A5000] WHERE f1 is not Null"), cnn
        Sheet1.Range("C2").CopyFromRecordset .DataSource
        .Close
        .Open ("Select * From [Amplitude$A2:B5000] WHERE f1 is not Null"), cnn2
        Sheet1.Range("E2").CopyFromRecordset .DataSource
        .Close
    End With
    Set Rec = Nothing
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Xong!"
End Sub
Chân thành cảm ơn bác đã giúp đỡ. Các code đều chạy rất mượt.
Nhìn đống dữ liệu em hàng ngày thấy ngán giờ khỏe quá rồi!
 
Upvote 0
Khoẻ?
Với hàng dữ liệu đó thì trong nghề gọi là data mining. Mà data mining thì người làm tự xoay sở các bề mặt của nó để còn moi ra được tin tức hữu ích. Đằng này nhờ người khác làm thì mỗi lần chuyển mặt hay pivot lại phải nhờ thêm code?

(*1) khi phân tích khảo sát dữ liệu dạng "cube" thì người ta phải thử nhiều mặt, pivot đủ các điểm/trục xoay.
 
Upvote 0
Khoẻ?
Với hàng dữ liệu đó thì trong nghề gọi là data mining. Mà data mining thì người làm tự xoay sở các bề mặt của nó để còn moi ra được tin tức hữu ích. Đằng này nhờ người khác làm thì mỗi lần chuyển mặt hay pivot lại phải nhờ thêm code?

(*1) khi phân tích khảo sát dữ liệu dạng "cube" thì người ta phải thử nhiều mặt, pivot đủ các điểm/trục xoay.
- Vâng bác!
- Chế ra dữ liệu rồi lại thu nhỏ rồi tính toán rồi quang ra các file(chủ ý do file quá to, hoặc hàm trong VBA giới hạn, chỗ này em sử dụng code nội suy của bác @HieuCD rất nhiều), hiện với code của bác @Maika8008 làm cho việc chia nhỏ file mà vẫn quản lý được không thành vấn đề! Dành thời gian hoàn thiện các bước tính toán rồi em tìm một ngôn ngữ, cách làm phù hợp hơn!
- Đúng ra mà nói dạng bài em đang làm thì phải là một tổ chức có chuyên môn mới ra USD.Thật cảm ơn bác cho những từ khóa mà đọc. Cảm ơn bác @VetMini !
Do tự học và mò mầm sóng Elliott, Hỗ trợ và Kháng cự (là đề cương thôi em cũng chưa nghiên cứu tài liệu nào) mới seach chung chung chưa cụ thể, bác có từng làm qua thì cho em xin hàm có đồ thị hình ziczac.Cho em xin từ khóa cũng may lắm rồi ạ!
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn bác nhìn code bài 22 không biết em làm gì mà thấy gớm!
- Bạn giúp cho em bài nữa với ạ!
View attachment 259502View attachment 259503
Có 2 file đang đóng muốn lấy dữ liệu từ 2 file đang dóng về file đang mở. Nhờ bác @Maika8008 và các bác giúp em với!
Tạo sheet Nguon lưu tên file vả địa chỉ dữ liệu
Chạy code
Mã:
Sub XYZ()
  Dim rs As Object, cnn As Object, aPath()
  Dim n&, j&, jCol&

  Application.ScreenUpdating = False
  Set cn = CreateObject("adodb.connection")
  With Sheets("Nguon")
    aPath = .Range("A3:K" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  jCol = 1
  With Sheets("Sheet1")
    .UsedRange.Offset(1).ClearContents
    For n = 1 To UBound(aPath) Step 2
      cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.Path & "\" & _
                aPath(n, 1) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
      For j = 2 To UBound(aPath, 2)
        If aPath(n, j) = Empty Then Exit For
        Set rs = cn.Execute("Select * From [" & aPath(n, j) & "$" & aPath(n + 1, j) & "] where f1 is not null")
        If Not rs.EOF Then .Cells(2, jCol).CopyFromRecordset rs
        rs.Close
        jCol = jCol + Range(aPath(n + 1, j)).Columns.Count
      Next j
      cn.Close
      jCol = jCol + 1
    Next n
  End With
    Set rs = Nothing: Set cn = Nothing
    Application.ScreenUpdating = True
    MsgBox "oK!"
End Sub
 

File đính kèm

Upvote 0
Chân thành cảm ơn bác đã giúp đỡ. Các code đều chạy rất mượt.
Nhìn đống dữ liệu em hàng ngày thấy ngán giờ khỏe quá rồi!

Code cho bài #27
Rich (BB code):
Sub LayNhieuSheet1()
Dim Rec As Object
Dim strPath1 As String, strPath2 As String, i As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Sheet1.Range("A2:C5000").ClearContents
    strPath1 = ThisWorkbook.Path & "\" & "dang_dong_2.xlsm"    'Duong dan co dinh
    strPath2 = ThisWorkbook.Path & "\" & "dang_dong_1.xlsm"    'Duong dan co dinh
    Dim cnn As String, cnn2 As String
    cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath1 & ";Extended Properties=""Excel 12.0 Xml;HDR=No"""
    cnn2 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath2 & ";Extended Properties=""Excel 12.0 Xml;HDR=No"""
    Set Rec = CreateObject("ADODB.Recordset")
    With Rec
        .Open ("Select * From [Date$A2:A5000] "), cnn
        Sheet1.Range("A2").CopyFromRecordset .DataSource
        .Close
        .Open ("Select * From [Time$A2:A5000] WHERE f1 is not Null"), cnn
        Sheet1.Range("B2").CopyFromRecordset .DataSource
        .Close
        .Open ("Select * From [Value$A2:A5000] WHERE f1 is not Null"), cnn
        Sheet1.Range("C2").CopyFromRecordset .DataSource
        .Close
        .Open ("Select * From [Amplitude$A2:B5000] WHERE f1 is not Null"), cnn2
        Sheet1.Range("E2").CopyFromRecordset .DataSource
        .Close
    End With
    Set Rec = Nothing
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Xong!"
End Sub

Em chào thầy @Maika8008

Nếu bài toán là chuyển dữ liệu từ File đang mở vào File đang đóng thì Code sẽ như thế nào thầy .

File đóng sẽ là File chính và hàng ngày sẽ chuyển dữ liệu từ N File con vào File chính

Em cảm ơn.
 
Upvote 0
Em chào thầy @Maika8008

Nếu bài toán là chuyển dữ liệu từ File đang mở vào File đang đóng thì Code sẽ như thế nào thầy .

File đóng sẽ là File chính và hàng ngày sẽ chuyển dữ liệu từ N File con vào File chính

Em cảm ơn.
Code làm mấy việc sau:
1. Mở file đang đóng
2. Chép dữ liệu vào.
3. Đóng và lưu file.
 
Upvote 0
tôi gợi ý cho chút vậy
1/ chọn 1 file Excel bất kỳ có nhiêu Sheet lấy lên hết xong gán dữ liệu nối tiếp xuống 1 sheet
2/ ko cần Open Files
3/ chọn nhiều file cũng thế
.....
thong thả làm đi .... tôi chỉ nói còn ko có làm ... nếu tò mò thì mấy Cái DLL tôi úp trên này nó đã có sẳn rồi
còn ta chỉ khai báo chút là dùng thôi ...

thong thả tìm là thấy
 
Upvote 0
Làm hàng ngày thì học Power Query mà làm. Microsoft tốn công sức ra cai này là để đáp ứng nhu cầu chuyển đổi dữ liệu từ nơi này sang nơi khác. ADO là là một tiện ích đọc/ghi dữ liệu ơ lớp trong (*1), rành nó thì mới có hiệu quả, cứ mỗi nhu cầu lại phải nhờ viết code giùm là khong nên.
Thời buổi công nghệ siêu xa lộ mà bám mãi các kiểu làm cũ rích.

(*1) ứng dụng vi tính có thể ví như củ hành. Những phần mềm có thể thuộc về lớp nào của củ hành. ADO nằm khoảng lớp thứ 3 đếm từ ngoài vào. Trong khi Power Query nằm ở lớp ngoài cùng. Các lớp càng sâu càng đòi hỏi người dùng phải biết về công nghệ và nền tảng công nghẹ.
 
Upvote 0
Làm hàng ngày thì học Power Query mà làm. Microsoft tốn công sức ra cai này là để đáp ứng nhu cầu chuyển đổi dữ liệu từ nơi này sang nơi khác. ADO là là một tiện ích đọc/ghi dữ liệu ơ lớp trong (*1), rành nó thì mới có hiệu quả, cứ mỗi nhu cầu lại phải nhờ viết code giùm là khong nên.
Thời buổi công nghệ siêu xa lộ mà bám mãi các kiểu làm cũ rích.

(*1) ứng dụng vi tính có thể ví như củ hành. Những phần mềm có thể thuộc về lớp nào của củ hành. ADO nằm khoảng lớp thứ 3 đếm từ ngoài vào. Trong khi Power Query nằm ở lớp ngoài cùng. Các lớp càng sâu càng đòi hỏi người dùng phải biết về công nghệ và nền tảng công nghẹ.

@VetMini @Kiều Mạnh
Dạ vâng, Em cảm ơn 2 thầy
 
Upvote 0
Tôi nghĩ bạn nên tự chủ làm lấy sau này sẻ ko vất vả nhờ nữa

1/ nhờ ai đó làm chạy hết 1s còn mình làm chạy 1 phút = ko sao cả
2/ làm trên tools gì ko quan trọng ... quan trọng là làm được cái gì cho cái việc mình đi nhờ

cố giắng làm chủ cho dù dở ẹc ... còn hơn đi nhờ làm
chịu khó tìm bài trên này chút .... Copy chỉnh sửa xem sao xong tính tiếp .... cứ vậy dần điều là làm được
 
Upvote 0
Tôi nghĩ bạn nên tự chủ làm lấy sau này sẻ ko vất vả nhờ nữa

1/ nhờ ai đó làm chạy hết 1s còn mình làm chạy 1 phút = ko sao cả
2/ làm trên tools gì ko quan trọng ... quan trọng là làm được cái gì cho cái việc mình đi nhờ

cố giắng làm chủ cho dù dở ẹc ... còn hơn đi nhờ làm
chịu khó tìm bài trên này chút .... Copy chỉnh sửa xem sao xong tính tiếp .... cứ vậy dần điều là làm được


Dạ em gửi Code của em, cũng tham khảo ở trên diễn đàn rồi làm ạ.

Code ở File Thí nghiệm xuất vào Main

Mã:
Sub ABC()
    
    Dim wb As Workbook
    Dim Sh, Sheet As Worksheet
    Dim Path, FileName As String
    Dim LrowNguon, LrowPhu, n, n1 As Long
    
      Set wb = ThisWorkbook
      Set Sh = wb.Sheets("Sheet1")
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
          Path = "C:\Users\della\Desktop\Gom Data\"
          FileName = Dir(Path & "Main.xlsm")
           
          Do While FileName <> ""
            Set wb = Application.Workbooks.Open(Path & FileName, WriteResPassword:="QCTEV")
              For Each Sheet In wb.Sheets
                If Sheet.Name = "Data" Then
                   wb.Activate
                   LrowPhu = Sh.Range("C" & Rows.Count).End(3).Row
                   
                     For n = 85 To LrowPhu Step 1
                     LrowNguon = wb.Sheets("Data").Range("B" & Rows.Count).End(3).Row + 1
                
                       For n1 = 2 To 23
                         wb.Sheets("Data").Cells(LrowNguon, n1).Value = Sh.Cells(n, n1).Value
                       Next n1
                       
                     Next n
        
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).Borders.LineStyle = 1
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).Font.Name = "Times New Roman"
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).Font.Size = 12
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).VerticalAlignment = xlCenter
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).HorizontalAlignment = xlCenter
                     
                End If
              Next Sheet
            wb.Close savechanges:=True
          FileName = Dir()
          Loop
          On Error Resume Next
         
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        
        MsgBox ("Xong roi!")
End Sub
 

File đính kèm

Upvote 0
Dạ em gửi Code của em, cũng tham khảo ở trên diễn đàn rồi làm ạ.

Code ở File Thí nghiệm xuất vào Main

Mã:
Sub ABC()
   
    Dim wb As Workbook
    Dim Sh, Sheet As Worksheet
    Dim Path, FileName As String
    Dim LrowNguon, LrowPhu, n, n1 As Long
   
      Set wb = ThisWorkbook
      Set Sh = wb.Sheets("Sheet1")
   
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
       
          Path = "C:\Users\della\Desktop\Gom Data\"
          FileName = Dir(Path & "Main.xlsm")
          
          Do While FileName <> ""
            Set wb = Application.Workbooks.Open(Path & FileName, WriteResPassword:="QCTEV")
              For Each Sheet In wb.Sheets
                If Sheet.Name = "Data" Then
                   wb.Activate
                   LrowPhu = Sh.Range("C" & Rows.Count).End(3).Row
                  
                     For n = 85 To LrowPhu Step 1
                     LrowNguon = wb.Sheets("Data").Range("B" & Rows.Count).End(3).Row + 1
               
                       For n1 = 2 To 23
                         wb.Sheets("Data").Cells(LrowNguon, n1).Value = Sh.Cells(n, n1).Value
                       Next n1
                      
                     Next n
       
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).Borders.LineStyle = 1
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).Font.Name = "Times New Roman"
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).Font.Size = 12
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).VerticalAlignment = xlCenter
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).HorizontalAlignment = xlCenter
                    
                End If
              Next Sheet
            wb.Close savechanges:=True
          FileName = Dir()
          Loop
          On Error Resume Next
        
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
       
        MsgBox ("Xong roi!")
End Sub
thế là tốt rồi cứ thế phát huy ....
 
Upvote 0
Dạ em gửi Code của em, cũng tham khảo ở trên diễn đàn rồi làm ạ.

Code ở File Thí nghiệm xuất vào Main

Mã:
Sub ABC()
   
    Dim wb As Workbook
    Dim Sh, Sheet As Worksheet
    Dim Path, FileName As String
    Dim LrowNguon, LrowPhu, n, n1 As Long
   
      Set wb = ThisWorkbook
      Set Sh = wb.Sheets("Sheet1")
   
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
       
          Path = "C:\Users\della\Desktop\Gom Data\"
          FileName = Dir(Path & "Main.xlsm")
          
          Do While FileName <> ""
            Set wb = Application.Workbooks.Open(Path & FileName, WriteResPassword:="QCTEV")
              For Each Sheet In wb.Sheets
                If Sheet.Name = "Data" Then
                   wb.Activate
                   LrowPhu = Sh.Range("C" & Rows.Count).End(3).Row
                  
                     For n = 85 To LrowPhu Step 1
                     LrowNguon = wb.Sheets("Data").Range("B" & Rows.Count).End(3).Row + 1
               
                       For n1 = 2 To 23
                         wb.Sheets("Data").Cells(LrowNguon, n1).Value = Sh.Cells(n, n1).Value
                       Next n1
                      
                     Next n
       
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).Borders.LineStyle = 1
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).Font.Name = "Times New Roman"
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).Font.Size = 12
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).VerticalAlignment = xlCenter
                     wb.Sheets("Data").Range("A2:W" & LrowNguon).HorizontalAlignment = xlCenter
                    
                End If
              Next Sheet
            wb.Close savechanges:=True
          FileName = Dir()
          Loop
          On Error Resume Next
        
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
       
        MsgBox ("Xong roi!")
End Sub
Bạn có thể qua link sau tham khảo thêm ... tùy chỉnh và chỉ sử dụng còn ko học được gì từ code cả ... nếu có thì cũng chút chút thôi
 
Upvote 0
Bạn có thể qua link sau tham khảo thêm ... tùy chỉnh và chỉ sử dụng còn ko học được gì từ code cả ... nếu có thì cũng chút chút thôi

Em cảm thầy nhiều ạ.
 
Upvote 0
Lúc trước em cũng hay thao tác với file CSV, lấy dữ liệu từ máy đo VMM, e hay dùng CMD, nhưng không biết có chứa được "hàng khủng" hay không, do không có nhu cầu cao vậy.
1645169636613.png
 
Upvote 0

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

Back
Top Bottom