[Hỏi] Đưa dữ liệu từ Sheet file 1 sang Sheet file 2. (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)
U

ultimatum86

Thành viên chính thức
Tham gia
19/11/10
Bài viết
79
Được thích
5
Xin chào Anh Chị GPE,

Em có 1 file Du lieu và 2 file Data (Data 1 và Data 2).

Trong file Du lieu có 1 button tại Sheet 2. Khi bấm button này nó sẽ hiện ra một cái bảng để mình tìm đến chổ lưu Data 1 và Data 2. Khi mình chọn Data 1 (hoặc Data 2) >> OK, thì toàn bộ nội dung trong Sheet Data (giống như Ctrl +A > Copy)trên file Data sẽ được copy vào Sheet 3 trên file dữ liệu. Khi chọn file Data 1 thì sẽ lấy giá trị theo file Data 1, tương tự cho file Data 2 (Vì khi em thêm thông tin vào file Data, em sẽ lưu lại với 1 tên mới). Theo em để tránh sai sót thông tin, khi bấm button thì toàn bộ nội dung hiện có trong Sheet 3 sẽ được xóa hết, sau đó nó cập nhật theo nội dung mới vào.

Mong Anh Chị viết Code giúp cho phần này nha.

Cảm ơn Anh Chị nhiều.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Mới học ADO nên có sai sót gì thì bạn check thử xem ok chưa nhé !

Mã: 
Sub Button1_Click()
    Dim cnn As Object, lsSQL As String, lrs As Object, lVersn As Long
    Dim Fso As Object, fn, Link As String, Fname As String, szConn As String
    Dim i As Long, j As Long, Arr()
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    lVersn = Val(Application.Version)
    'Mo hop thoai chon thu muc
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "GIAI PHAP EXCEL"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xlsx"
        If .Show = -1 Then
            Fname = .SelectedItems(1)
        Else
            MsgBox "BAN KHONG CHON FILE DE COPY !", vbInformation, "GIAI PHAP EXCEL"
            Exit Sub
        End If
    End With
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    If Fname <> ThisWorkbook.FullName Then
        'Tao ket noi CSDL
        If lVersn < 12 Then
            szConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fname & ";" & _
                      "Extended Properties=""Excel 8.0;HDR=No"";IMEX=1;"
        Else
            szConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fname & ";" & _
                      "Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
        End If
        With cnn
            .ConnectionString = szConn
            .Open
        End With
        'Cau lenh truy van
        lsSQL = "SELECT * FROM [DaTa$A4:Q5536]"
        lrs.Open lsSQL, cnn, 3, 1
        With Sheet3
            If .AutoFilterMode Then .AutoFilterMode = False
            If .Range("B65500").End(xlUp).Row > 2 Then .Range("A3:Q" & .Range("B65500").End(xlUp).Row).ClearContents
            .Range("A3").CopyFromRecordset lrs
        End With
        cnn.Close: lrs.Close
    Else
        MsgBox "BAN KHONG DUOC CHON FILE DANG MO NHE !", "GIAI PHAP EXCEL"
        GoTo Thoat
    End If
    
Thoat:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Set lrs = Nothing
    Set cnn = Nothing
End Sub
 
Upvote 0
quocphuoc88 đã viết:
Mới học ADO nên có sai sót gì thì bạn check thử xem ok chưa nhé !

Mã: 
Sub Button1_Click()
    Dim cnn As Object, lsSQL As String, lrs As Object, lVersn As Long
    Dim Fso As Object, fn, Link As String, Fname As String, szConn As String
    Dim i As Long, j As Long, Arr()
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    lVersn = Val(Application.Version)
    'Mo hop thoai chon thu muc
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "GIAI PHAP EXCEL"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xlsx"
        If .Show = -1 Then
            Fname = .SelectedItems(1)
        Else
            MsgBox "BAN KHONG CHON FILE DE COPY !", vbInformation, "GIAI PHAP EXCEL"
            Exit Sub
        End If
    End With
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    If Fname <> ThisWorkbook.FullName Then
        'Tao ket noi CSDL
        If lVersn < 12 Then
            szConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fname & ";" & _
                      "Extended Properties=""Excel 8.0;HDR=No"";IMEX=1;"
        Else
            szConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fname & ";" & _
                      "Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
        End If
        With cnn
            .ConnectionString = szConn
            .Open
        End With
        'Cau lenh truy van
        lsSQL = "SELECT * FROM [DaTa$A4:Q5536]"
        lrs.Open lsSQL, cnn, 3, 1
        With Sheet3
            If .AutoFilterMode Then .AutoFilterMode = False
            If .Range("B65500").End(xlUp).Row > 2 Then .Range("A3:Q" & .Range("B65500").End(xlUp).Row).ClearContents
            .Range("A3").CopyFromRecordset lrs
        End With
        cnn.Close: lrs.Close
    Else
        MsgBox "BAN KHONG DUOC CHON FILE DANG MO NHE !", "GIAI PHAP EXCEL"
        GoTo Thoat
    End If
    
Thoat:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Set lrs = Nothing
    Set cnn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Hi Anh,

Sau khi chạy thì nó bị lỗi như sau.
Error.jpg
Phần màu xanh là em có chỉnh sửa để lấy hết nội dung trong file Data. Phần màu đỏ là bị báo lỗi, Em đã thử mở file data khi cập nhật thì nó vẫn báo lỗi như thế. Nó báo lỗi nhưng mà trong Sheet 3 vẫn cập nhật giá trị. Anh xem lại giúp em nha.
 
Upvote 0
Bạn bỏ chổ này
Mã: 
[COLOR=#000000][I]cnn.Close: lrs.Close[/I][/COLOR]

và thay bằng

Mã: 
Thoat:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    lrs.Close: Set lrs = Nothing
    cnn.Close: Set cnn = Nothing

Do mới mày mò học ADO nên chưa hiểu nhiều, mong bạn thông cảm !
 
Upvote 0
quocphuoc88 đã viết:
Bạn bỏ chổ này
Mã: 
[COLOR=#000000][I]cnn.Close: lrs.Close[/I][/COLOR]

và thay bằng

Mã: 
Thoat:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    lrs.Close: Set lrs = Nothing
    cnn.Close: Set cnn = Nothing

Do mới mày mò học ADO nên chưa hiểu nhiều, mong bạn thông cảm !
Nhấp chuột vào đây để mở rộng...

Mới học mà như vậy là tuyệt vời rồi anh ah. Bây giờ, ví dụ em có 1 file Data Access có đặt Password, mình có thể lấy dữ liệu này sang được không anh(Mình sẽ khai báo Password trong code để truy cập) ? Mục đích là để người khác không mở được file Data (File Access).
 
Upvote 0
Nói chung là đóng thắng truy vấn trước rồi đóng kế nối sau. Trong câu lệnh If là phải đóng truy vần và kết nối rồi
Mã: 
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing
Nếu bị lỗi mà Thoát thì đóng tiếp giống trên
Mã: 
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing
Mà Thoat bạn thấy lạ lạ nếu truy vấn thành công thì End sub làm gì mà dùng bước nhảy Thoat?
 
Upvote 0
nmhung49 đã viết:
Nói chung là đóng thắng truy vấn trước rồi đóng kế nối sau. Trong câu lệnh If là phải đóng truy vần và kết nối rồi
Mã: 
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing
Nếu bị lỗi mà Thoát thì đóng tiếp giống trên
Mã: 
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing
Mà Thoat bạn thấy lạ lạ nếu truy vấn thành công thì End sub làm gì mà dùng bước nhảy Thoat?
Nhấp chuột vào đây để mở rộng...

Em vẫn chưa hiểu rõ.

Hiện tại Code này em chạy ok rồi, nhưng nếu Chị thấy có thể rút gọn Code trên thì chị điều chỉnh giúp ạ.

Em muốn hỏi thêm xíu:

- Em muốn Cell phía dưới Button sẽ hiển thị tên file Data mình liên kết thì làm thế nào ạ. Ví dụ khi mình lấy dữ liệu từ file Data 2014-PW02 R1.xls thì Cell D5 bên Sheet 2 sẽ hiển thị là : "Data 2014-PW02 R1" , để sau này còn biết mình liên kết file nào.

- Nếu file Excel có đặt Password open thì mình có thể lấy dữ liệu ko?( có thể khai báo Password trong Code để nó tự đăng nhập??)
 
Upvote 0
ultimatum86 đã viết:
Em vẫn chưa hiểu rõ.

Hiện tại Code này em chạy ok rồi, nhưng nếu Chị thấy có thể rút gọn Code trên thì chị điều chỉnh giúp ạ.

Em muốn hỏi thêm xíu:

- Em muốn Cell phía dưới Button sẽ hiển thị tên file Data mình liên kết thì làm thế nào ạ. Ví dụ khi mình lấy dữ liệu từ file Data 2014-PW02 R1.xls thì Cell D5 bên Sheet 2 sẽ hiển thị là : "Data 2014-PW02 R1" , để sau này còn biết mình liên kết file nào.

- Nếu file Excel có đặt Password open thì mình có thể lấy dữ liệu ko?( có thể khai báo Password trong Code để nó tự đăng nhập??)
Nhấp chuột vào đây để mở rộng...

Thay đoạn code trên bằng
Mã: 
With Workbooks.Open(fname, , , , [COLOR=#ff0000][B]1[/B][/COLOR])
            cnn.ConnectionString = szConn
            cnn.Open
        
        'Cau lenh truy van
        lsSQL = "SELECT * FROM [DaTa$A4:Q5536]"
            lrs.Open lsSQL, cnn, 3, 1
        With Sheet3
            If .AutoFilterMode Then .AutoFilterMode = False
            If .Range("B65500").End(xlUp).Row > 2 Then .Range("A3:Q" & .Range("B65500").End(xlUp).Row).ClearContents
            .Range("A3").CopyFromRecordset lrs
        End With
            Sheet2.Range("G1000").End(xlUp).Offset(1).Value = Dir(fname)
            .Close False
        End With
        lrs.Close: Set lrs = Nothing
        cnn.Close: Set cnn = Nothing
Số 1 password file mở lấy dữ liệu nếu copy đơn thuần thì dùng code này cũng được

Mã: 
Sub Test()
Dim fname
fname = Application.GetOpenFilename("Excel Files (*.xls*), *.xls")
With Workbooks.Open(fname, , , , [COLOR=#b22222][B]1[/B][/COLOR])
    Sheets("Data").Range("A4:U1000").Copy ThisWorkbook.Sheets("Sheet3").Range("A3")
    .Close False
End With
Sheet2.Range("G1000").End(xlUp).Offset(1).Value = Dir(fname)
End Sub
Với số 1 là password
 
Upvote 0
Theo tôi nếu file Excel có Password không nên dùng ADO vì ADO không thể truy vấn tới File Excel có password khi file đó đóng do đó mất đi thế mạnh của ADO. Một giải pháp có thể lựa chọn đó là dùng VBA thông thường => chọn File để mở => Copy => Dán vào đích
Mã: 
Sub Copy()
    Dim Fname As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xlsx;*.xlsm;*.xlsb;*.xls"
        If .Show = -1 Then
            Fname = .SelectedItems(1)
        Else
            MsgBox "BAN KHONG CHON FILE DE COPY !", vbInformation, "Thong bao"
            Exit Sub
        End If
    End With
    Sheet3.Range("A1:A65536").EntireRow.Delete
    'So 1 la Password
    With Workbooks.Open(Fname, , , , 1)
        .Sheets("Data").UsedRange.Copy Sheet3.[A1]
        .Close
    End With
End Sub
 
Upvote 0
Sau khi em test cả 3 Code trên, có 1 số nhận xét như sau:

- Code anh quocphuoc88 : Chạy nhanh nhất, copy 7000 dòng qua mà tic tak là xong.

- Code chị nmhung49 : Khi chạy màng hình giật 1 cái, về phần hiện tên file trong Sheet 2, mỗi lần cập nhật là nó tạo ra 1 dòng. Ở đây em muốn nó hiện cố định 1 ô thôi, cụ thể là ô D5 trong Sheet 2, khi cập nhật tiếp thì nó đè lên cái trước và không hiển thị .XLS luôn nha chị.

- Code anh dhn46 :Khi chạy code thì bị màng hình trắng khoảng 2s, khi copy 7000 dòng thì sau màng hình trắng là nó chạy load bao nhiêu % ở dưới. và file của anh chưa có phần hiển thị tên file bên Sheet 2.

>>> Code truy cập Password của Anh Chị chỉ có thể làm cho file đặt PW là số, khi đặt PW là chữ cái thì nó báo lỗi.
 
Upvote 0
Tôi nghĩ rằng bạn có thể Edit được Code và biết được một số thủ thuật nhằm nâng cao tốc độ Code? Nhưng với bài #10 có lẽ bạn nển chú ý một số điểm sau:

1/ Để nâng tăng tốc code bạn chú ý các dòng lệnh
Mã: 
Sub ABC
'Dat o dau 1 sub
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

...........................

'Dat o cuoi 1 sub
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
Chú ý này áp dụng cho Code bài #8, #9

2/ Code bài bạn nmhung49 về việc hiển thị đường dẫn đã có bạn chỉ cần tìm hiểu và edit 1 chút là được.
Mã: 
'Code cu
Sheet2.Range("G1000").End(xlUp).Offset(1).Value = Dir(Fname)

'Chinh lai 1 chut
Sheet2.Range("D5").Value = Dir(Fname)
 
Upvote 0
ultimatum86 đã viết:
Sau khi em test cả 3 Code trên, có 1 số nhận xét như sau:

- Code anh quocphuoc88 : Chạy nhanh nhất, copy 7000 dòng qua mà tic tak là xong.

- Code chị nmhung49 : Khi chạy màng hình giật 1 cái, về phần hiện tên file trong Sheet 2, mỗi lần cập nhật là nó tạo ra 1 dòng. Ở đây em muốn nó hiện cố định 1 ô thôi, cụ thể là ô D5 trong Sheet 2, khi cập nhật tiếp thì nó đè lên cái trước và không hiển thị .XLS luôn nha chị.

- Code anh dhn46 :Khi chạy code thì bị màng hình trắng khoảng 2s, khi copy 7000 dòng thì sau màng hình trắng là nó chạy load bao nhiêu % ở dưới. và file của anh chưa có phần hiển thị tên file bên Sheet 2.

>>> Code truy cập Password của Anh Chị chỉ có thể làm cho file đặt PW là số, khi đặt PW là chữ cái thì nó báo lỗi.
Nhấp chuột vào đây để mở rộng...
Bạn đặt Password open file thì bắt buộc phải mở pass rồi copy được vì ADO không thể làm việc với file bị đặt pass
Thêm đoạn code này ở đầu và cuối thủ tục để không bị giât
Mã: 
Application.ScreenUpdating = False
-------
Application.ScreenUpdating = True
Muốn hiện ở chỗ D5 thêm đoạn này vào

Sheet2.Range("D5").Value = Left(Dir(fname), VBA.InStrRev(Dir(fname), ".") - 1)
Nếu đổi pass thì phải đổi pass trong code để nó đổi theo. Có thể bạn chữ cái bị lỗi tiếng Việt không?
 
Upvote 0
nmhung49 đã viết:
Bạn đặt Password open file thì bắt buộc phải mở pass rồi copy được vì ADO không thể làm việc với file bị đặt pass
Thêm đoạn code này ở đầu và cuối thủ tục để không bị giât
Mã: 
Application.ScreenUpdating = False
-------
Application.ScreenUpdating = True
Muốn hiện ở chỗ D5 thêm đoạn này vào

Sheet2.Range("D5").Value = Left(Dir(fname), VBA.InStrRev(Dir(fname), ".") - 1)
Nếu đổi pass thì phải đổi pass trong code để nó đổi theo. Có thể bạn chữ cái bị lỗi tiếng Việt không?
Nhấp chuột vào đây để mở rộng...

Cảm ơn Anh Chị đã giúp em rất nhiều. file code bây giờ của em là
PHP: 
Sub Update()Dim fname
Application.ScreenUpdating = False
fname = Application.GetOpenFilename("Excel Files (*.xls*), *.xls")
' PW can dat trong dau ngoac kep
With Workbooks.Open(fname, , , , "angleagle")
    Sheets("PW Data").Range("A4:U1000").Copy ThisWorkbook.Sheets("Sheet3").Range("A3")
    .Close False
End With
'Sheet2.Range("G1000").End(xlUp).Offset(1).Value = Dir(fname)
Sheet2.Range("D5").Value = Left(Dir(fname), VBA.InStrRev(Dir(fname), ".") - 1)
Application.ScreenUpdating = True
End Sub

Về phần Password, mình để trong dấu ngoặc kép là ok, có thể đặt PW là chữ luôn.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

phuongnam366377
VbaTools – Bộ công cụ mở rộng cho VBA trong Excel (8 người xem)
Trả lời
7
Đọc
63
phuongnam366377
phuongnam366377
L
Nhờ giúp đỡ công thức tính công từ dữ liệu trích xuất ra từ File chấm công (1 người xem)
Trả lời
0
Đọc
10
lưu tuấn dũng
L
H
Excel không lọc được toàn bộ dữ liệu
Trả lời
0
Đọc
12
Hongphong123
H
Tuanba1992
Lập trình Excel có thể dùng ngôn ngữ lập trình nào? (1 người xem)
Trả lời
6
Đọc
249
nguyendang95
N
H
Tổng hợp Công Nợ theo Công trình
Trả lời
27
Đọc
379
HangktGTN
H
H
  • Đã khóa
Công Thức Tính Tổng Công Nợ Khách Hàng
Trả lời
1
Đọc
31
ptm0412
ptm0412
B
Mình có làm đoạn code VBA trong file access mà cứ báo lỗi nhờ mọi người hướng dẫn
Trả lời
8
Đọc
135
ptm0412
ptm0412
GPE-Trợ Lý
CHÀO MỪNG 80 NĂM QUỐC KHÁNH (1 người xem)
    • Thích
    • Yêu thích
Trả lời
0
Đọc
46
GPE-Trợ Lý
GPE-Trợ Lý
thanhss
Tự động lấy dữ liệu từ các sheet khác đưa vào sheet tổng hợp khi chọn Ngày hoặc tháng hoặc năm (1 người xem)
Trả lời
21
Đọc
247
thanthanhan
thanthanhan
vuthaiha90
Lọc dữ liệu không trùng và trả kết quả về 1 dòng
Trả lời
7
Đọc
280
tranhungdao12a3
T
T
Nhờ anh chị xem giúp file bị lỗi gì mà chạy rất chậm/lag - File tính tiền nhà trọ (1 người xem)
Trả lời
10
Đọc
400
Thaik05
T
Nguyễn Duy Tuân
Hàm BS COMBINLIST Liệt kê các giá trị tổ hợp, chỉnh hợp, chỉnh hợp không lặp | Add-in A-Tools v10
    • Yêu thích
    • Thích
Trả lời
24
Đọc
2K
nguyendang95
N
J
Xử lý các file Excel bị nặng sau nhiều năm sử dụng
Trả lời
13
Đọc
2K
huhumalu
H
hongphuong1997
Nên sử dụng Chatgpt hay Copilot
    • Yêu thích
Trả lời
12
Đọc
378
phuongnam366377
phuongnam366377
L
File Excel nặng chưa tìm được lý do ở đâu . Mong các bác hỗ trợ !
Trả lời
5
Đọc
144
PhanTuHuong
PhanTuHuong
U
VB tính tổng số cell trong 1 hàng có cùng màu với 1 cell so sánh ở cột khác
Trả lời
5
Đọc
104
Hoàng Tuấn 868
H
T
VBA LẤY THÔNG TIN TRÊN TỜ KHAI NHẬP KHẨU
Trả lời
10
Đọc
672
binhminh1408
B
H
Giúp mình ghép nhiều file thành một file. (2 người xem)
Trả lời
10
Đọc
475
hanhnguyen120221cuty
H
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
18
Đọc
1K
Hoàng Tuấn 868
H
HeSanbi
  • Đã giải quyết
ZaloExcel v2.96: Gửi tin nhắn, hình ảnh, bảng, biểu đồ, tập tin, tạo nhóm, thu thập tin nhắn (2 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
60
Đọc
20K
HeSanbi
HeSanbi
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom