Sử dụng ADO lấy dữ liệu Nhiều Sheet trong 1 file đóng mà không Biết tên Sheet (1 người xem)

Liên hệ QC

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

Kiều Mạnh

I don't program, I beat code into submission!!!
Tham gia
9/6/12
Bài viết
5,538
Được thích
4,132
Giới tính
Nam
Tình hình là Mạnh đang ngâm cứu có thể dùng ADO lấy dữ liêu ở tất cả các Sheet trong một File lên một File khác ....mà chỉ Biết vùng dữ liệu của các Sheet đó mà không biết tên tất cả các Sheet của File đó

Có nghĩa là trong File đó có bao nhiêu Sheet không cần biết (Tên Sheet Linh Tinh..)... chỉ biết lấy dữ

liệu theo vùng [A7:J100] gán nối tiếp nhau lên Sheet TongHop file

Tonghop.xlsb của một File mở mà khó quá chưa Nghĩ ra được ....

Vây úp bài nhờ các Bạn tham gia trợ giúp
Không biết ý tưởng có thực hiện được hay không hay là Hoang Đường....--=0--=0
 

File đính kèm

Lần chỉnh sửa cuối:
ý tưởng của bạn dễ thực hiện thôi mà.
 
Upvote 0
Cái này đã bàn qua trong các mục về ADO - hình như mục đó vui thì phải.

Có it nhất 2 cách làm: 1 là dùng ADOX và 2 là dùng phương thức GetScherma
Mình sử dụng code sau của GPE chạy thì tạm ok rồi đó ... nhưng với tên Sheet là:
Kiều Mạnh hay ##$$$^' là nó Tịt luôn ....+-+-+-+
Mã:
Sub LayTenSheet()
    Dim Dbs  As Object, db As Object, tbl As Object, Path
    Path = ThisWorkbook.Path & "\6A3.xls"
    Set Dbs = CreateObject("DAO.DBEngine.36")
    Set db = Dbs.OpenDatabase(Path, False, False, "Excel 8.0;")
    For Each tbl In db.TableDefs
        If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$[SIZE=6][COLOR=#ff0000][B]'[/B][/COLOR][/SIZE]" Then
            MsgBox tbl.Name
        End If
    Next tbl
    db.Close
    Set Dbs = Nothing: Set db = Nothing: Set tbl = Nothing
End Sub

Và Mình cũng chưa hiểu lắm cái dấu màu đỏ kiêm tra Msgbox thì thấy có tên Sheet ##$$$^' nhưng sử dụng ADO lấy lên lại ko có ....mà nếu cho dấu đó vào là lỗi code mà bỏ đi thì OK
 
Lần chỉnh sửa cuối:
Upvote 0
Cái dấu màu đỏ đó là cái dấu có tác dụng cho trường hợp tên sheet có dấu trắng, ký tự đặc biệt hay ngôn ngữ khác nhưng bạn thiếu 1 "ngoe" nha. Nó giống như công thức sau:

=Anh_Manh!A15 (Không cần thiết)
='Anh Mạnh'!A15 (Cần thiết)

Nhất là công thức do Excel tự động lập thì nó luôn thêm vào, còn người dùng thì hay lược bớt máy tự hiểu. Ví dụ nhập +A15 thì máy sẽ hiểu là =A15
 
Lần chỉnh sửa cuối:
Upvote 0
Mình sử dụng code sau của GPE chạy thì tạm ok rồi đó ... nhưng với tên Sheet là:
Kiều Mạnh hay ##$$$^' là nó Tịt luôn ....+-+-+-+
Mã:
Sub LayTenSheet()
    Dim Dbs  As Object, db As Object, tbl As Object, Path
    Path = ThisWorkbook.Path & "\6A3.xls"
    Set Dbs = CreateObject("DAO.DBEngine.36")
    Set db = Dbs.OpenDatabase(Path, False, False, "Excel 8.0;")
    For Each tbl In db.TableDefs
        If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$[SIZE=6][COLOR=#ff0000][B]'[/B][/COLOR][/SIZE]" Then
            MsgBox tbl.Name
        End If
    Next tbl
    db.Close
    Set Dbs = Nothing: Set db = Nothing: Set tbl = Nothing
End Sub

Và Mình cũng chưa hiểu lắm cái dấu màu đỏ kiêm tra Msgbox thì thấy có tên Sheet ##$$$^' nhưng sử dụng ADO lấy lên lại ko có ....mà nếu cho dấu đó vào là lỗi code mà bỏ đi thì OK

khi sử dụng ADO thì tên các sheet chỉ nên chứa các kí tự đơn giản như [A-Z_1-9]
tên sheet chứa các kí tự lạ như # gì đó ADO sẽ trả về sai tên sheet
lúc này sẽ có 1 số lựa chọn như sau :
1/Sử dụng code
dễ thực hiện thôi mà.
code đó sẽ rất hoàn hảo, nhưng nhiều khả năng Kiều Mạnh sẽ phải góp phần trả tiền điện , tiền máy lạnh , điện thoại , .... để nhìn thấy code đó

2/dùng Workbook.open , cách này thì phổ thông nhưng chắc Kiều Mạnh sẽ không thích

Bởi vậy tốt nhất là ta nên quy ước tên sheet chỉ gồm những kí tự đơn giản thôi .
 
Upvote 0
khi sử dụng ADO thì tên các sheet chỉ nên chứa các kí tự đơn giản như [A-Z_1-9]
tên sheet chứa các kí tự lạ như # gì đó ADO sẽ trả về sai tên sheet
lúc này sẽ có 1 số lựa chọn như sau :
1/Sử dụng code

code đó sẽ rất hoàn hảo, nhưng nhiều khả năng Kiều Mạnh sẽ phải góp phần trả tiền điện , tiền máy lạnh , điện thoại , .... để nhìn thấy code đó

2/dùng Workbook.open , cách này thì phổ thông nhưng chắc Kiều Mạnh sẽ không thích

Bởi vậy tốt nhất là ta nên quy ước tên sheet chỉ gồm những kí tự đơn giản thôi .
Ngồi nghĩ hoài cách xử lý mấy ký tự kỳ quái đó thì code GPE có hết rồi đó (code kinh điểm Luôn)...Chỉ việc copy xài thôi...nhưng đang nghĩ xem có cách nào rút gon lại mà khác biệt một chút hay không

Xài ké code sau của Anh Ndu thì có ký tự ngoài hành tinh nó cũng lấy luôn đó ..và code sub Main cực kỳ đơn giản

code bài 16
http://www.giaiphapexcel.com/forum/showthread.php?102883-Code-lấy-tên-sheet-bỏ-vào-1-file-khác/page2

ListSheet = Path & "\6A3.xlsb"
Res = GetSheets(False, ListSheet)

Như vậy Thì Mạnh chỉ viết thêm một Hàm đơn giản nữa kết nối nó lại chạy một dòng code truyền các tham số vào là xong...nhưng đang muốn khám phá nghiên cứu mới thôi mà ...
Xài ké nhiều thấy cũng ngại ...|||||/-*+/
 
Upvote 0
Ngồi nghĩ hoài cách xử lý mấy ký tự kỳ quái đó thì code GPE có hết rồi đó (code kinh điểm Luôn)...Chỉ việc copy xài thôi...nhưng đang nghĩ xem có cách nào rút gon lại mà khác biệt một chút hay không

Xài ké code sau của Anh Ndu thì có ký tự ngoài hành tinh nó cũng lấy luôn đó ..và code sub Main cực kỳ đơn giản

code bài 16
http://www.giaiphapexcel.com/forum/showthread.php?102883-Code-lấy-tên-sheet-bỏ-vào-1-file-khác/page2

ListSheet = Path & "\6A3.xlsb"
Res = GetSheets(False, ListSheet)

Như vậy Thì Mạnh chỉ viết thêm một Hàm đơn giản nữa kết nối nó lại chạy một dòng code truyền các tham số vào là xong...nhưng đang muốn khám phá nghiên cứu mới thôi mà ...
Xài ké nhiều thấy cũng ngại ...|||||/-*+/

xin anh Kiều Mạnh cho biết kí tự "." (chấm) là của hành tinh nào ? và thử nhét kí tự đó vào tên sheet xem
tiền điện , máy lạnh , điện thoại , ... cho có code hoàn hảo . hahahhaha -+*/-+*/-+*/
 
Upvote 0
xin anh Kiều Mạnh cho biết kí tự "." (chấm) là của hành tinh nào ? và thử nhét kí tự đó vào tên sheet xem
tiền điện , máy lạnh , điện thoại , ... cho có code hoàn hảo . hahahhaha -+*/-+*/-+*/
Ồ mà cái màu đo đỏ đó lỗi code thiệt.....mà mấy ai xài tên sheet vậy ta......./-*+/+-+-+-+..hahahaha

mà kể ra cũng hay hồi nảy chạy nó lỗi .... giờ chạy lại mấy cái hết lỗi ...hay có ma...
 
Lần chỉnh sửa cuối:
Upvote 0
Ồ mà cái màu đo đỏ đó lỗi code thiệt.....mà mấy ai xài tên sheet vậy ta......./-*+/+-+-+-+..hahahaha

mà kể ra cũng hay hồi nảy chạy nó lỗi .... giờ chạy lại mấy cái hết lỗi ...hay có ma...
đây là code của anh chim hồng. kiều mạnh thử xem sao
PHP:
Public Sub chim_hong()
Dim cn As Object, cat As Object, filename, sheetname As String, tbl As Object, vFile
On Error Resume Next
Set cn = CreateObject("ADODB.Connection")
Set cat = CreateObject("ADOX.Catalog")
vFile = Application.GetOpenFilename("Excel File, *.xl*", , , , True)
If TypeName(vFile) = "Variant()" Then
    For Each filename In vFile
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";mode=read;Extended Properties=""Excel 12.0;HDR=no"";"
        Set cat.ActiveConnection = cn
        For Each tbl In cat.tables
            If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$'" Then
                sheetname = " [" & Replace(tbl.Name, "'", "") & "A1:AM20000]"
                Sheet1.Range("A100000").End(xlUp).Offset(1) _
                .CopyFromRecordset cn.Execute("select * from " & sheetname)
            End If
        Next
        cn.Close
    Next
End If
End Sub
 
Upvote 0
đây là code của anh chim hồng. kiều mạnh thử xem sao
PHP:
Public Sub chim_hong()
Dim cn As Object, cat As Object, filename, sheetname As String, tbl As Object, vFile
On Error Resume Next
Set cn = CreateObject("ADODB.Connection")
Set cat = CreateObject("ADOX.Catalog")
vFile = Application.GetOpenFilename("Excel File, *.xl*", , , , True)
If TypeName(vFile) = "Variant()" Then
    For Each filename In vFile
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";mode=read;Extended Properties=""Excel 12.0;HDR=no"";"
        Set cat.ActiveConnection = cn
        For Each tbl In cat.tables
            If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$'" Then
                sheetname = " [" & Replace(tbl.Name, "'", "") & "A1:AM20000]"
                Sheet1.Range("A100000").End(xlUp).Offset(1) _
                .CopyFromRecordset cn.Execute("select * from " & sheetname)
            End If
        Next
        cn.Close
    Next
End If
End Sub
Chạy tốt đó Anh....còn Em xài ké cái Hàm của Anh Ndu cũng chạy tốt mà...
Em mới Test lại mấy lần thấy Ok hết
 
Lần chỉnh sửa cuối:
Upvote 0
Mạnh ngồi coi tới lui code bài 11 thấy có dòng này hay thiệt ....hình như cách viết đó mới viết lần đầu trên GPE hay sao ý ....--=0-\\/.

Set cat.ActiveConnection = cn
 
Upvote 0
đây là code của anh chim hồng. kiều mạnh thử xem sao
PHP:
Public Sub chim_hong()
Dim cn As Object, cat As Object, filename, sheetname As String, tbl As Object, vFile
On Error Resume Next
Set cn = CreateObject("ADODB.Connection")
Set cat = CreateObject("ADOX.Catalog")
vFile = Application.GetOpenFilename("Excel File, *.xl*", , , , True)
If TypeName(vFile) = "Variant()" Then
    For Each filename In vFile
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";mode=read;Extended Properties=""Excel 12.0;HDR=no"";"
        Set cat.ActiveConnection = cn
        For Each tbl In cat.tables
            If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$'" Then
                sheetname = " [" & Replace(tbl.Name, "'", "") & "A1:AM20000]"
                Sheet1.Range("A100000").End(xlUp).Offset(1) _
                .CopyFromRecordset cn.Execute("select * from " & sheetname)
            End If
        Next
        cn.Close
    Next
End If
End Sub
Xin chào anh,
Em đang sử dụng code của anh Chim_hong nhưng gặp vấn đề như sau:
File tổng hợp em tạo ra nhiều sheet, mỗi sheet em dán code trên vào nhưng khi code chạy thì dữ liệu đều tự động chuyển về sheet đàu tiên trong file tổng hợp. làm phiền anh giúp em chỉnh code trên để dùng cho nhiều sheet tổng hợp được không ạ.
 
Upvote 0
Web KT

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

Back
Top Bottom