Lấy dữ liệu từ access vào excel bằng VBA

Liên hệ QC
Kiều Mạnh đã viết:
Nếu Lấy nguyên 1 TableName lên Sheet thì đơn giản lắm ... Bạn có Thể sử dụng ADO Or DAO để lấy lên Sheet ...

Mình xài cả 2 cái như nhau ...trong trường hợp này Mình Viết DAO cho Bạn vì theo mình áp dụng cho Access code nó sẻ đơn giản nhất

1/ Mình viết tặng Bạn Một cái Hàm DAO đơn giản nhất sau này bạn sẻ sử dụng nó cho nhiều trường hợp khác ... vv
2/ Code lấy dữ liệu từ 1 TableName lên từ đó tham khảo mà viết thêm
Mã: 
Public Function MyDAO(ByVal AccPath As String)
    Dim Db As Object, Ws As Object
    Rem Neu Office 2003 - 2007 Use 36 Or 2010 To 2016 Use 120
    Set Db = CreateObject("DAO.DBEngine.120")
    Set Ws = Db.Workspaces(0)
    Set MyDAO = Ws.OpenDatabase(AccPath)
End Function
 
Public Sub GetDataBase()
    Dim Db As Object
    Dim Rs As Object
    Dim AccPath As String
    AccPath = ThisWorkbook.Path & "\dam2.mdb"
    Set Db = MyDAO(AccPath)
    Set Rs = Db.OpenRecordset("Beam Forces")
    Range("A10").CopyFromRecordset Rs
End Sub
Nhấp chuột vào đây để mở rộng...
E chào bác! E cũng đang gặp trường hợp giống bạn đang thắc mắc, e có làm theo hướng dẫn của bác, thì việc lấy dữ liệu từ File Access vào Excel đã thực hiện được, nhưng có 1 chút vấn đề, đó là bảng dữ liệu bên Access khi e đưa sang Excel thì toàn bộ các bảng đều mất đi phần đầu danh mục trên cùng, mong bác giúp e với, thực sự e ko biết gì về VBA, e chỉ mò mẫm theo hướng dẫn của các bác trên này để tự làm. E chân thành cảm ơn!
Đây là đoạn code e tự chế, bác xem giúp e xem e sai ở đâu ạ?

Public Function MyDAO(ByVal AccPath As String)
Dim Db As Object, Ws As Object
Rem Neu Office 2003 - 2007 Use 36 Or 2010 To 2016 Use 120
Set Db = CreateObject("DAO.DBEngine.36")
Set Ws = Db.Workspaces(0)
Set MyDAO = Ws.OpenDatabase(AccPath)
End Function
Public Sub GetDataBase()
Dim Db As Object
Dim Rs As Object
Dim Rp As Object
Dim Rq As Object
Dim AccPath As String
AccPath = Application.GetOpenFilename("TEXT FILES(*.mdb),*.mdb")
Set Db = MyDAO(AccPath)

Set Rs = Db.OpenRecordset("Frame Sections")
Sheets("Frame Sections").Select
Columns("A:V").Select
Selection.Delete
Range("A1").Select
Range("A1").CopyFromRecordset Rs

Set Rp = Db.OpenRecordset("Frame Assignments - Summary")
Sheets("Frame Assignments- Summary").Select
Columns("A:V").Select
Selection.Delete
Range("A1").Select
Range("A1").CopyFromRecordset Rp

Set Rq = Db.OpenRecordset("Column Forces")
Sheets("Column Forces").Select
Columns("A:V").Select
Selection.Delete
Range("A1").Select
Range("A1").CopyFromRecordset Rq

Sheets("ThepCot").Select
Range("A1").Select
End Sub
Nhấp chuột vào đây để mở rộng...

E có đính kèm ảnh, phần tiêu đề trên cùng mất hết!
Lưu ý là khi e dùng chức năng import external data của excel vào thì phần tiêu đề dòng trên cùng còn nguyên chứ ko bị mất!
 

File đính kèm

  • Minh hoa.jpg
    Minh hoa.jpg
    172.2 KB · Đọc: 18
  • TN2.rar
    11.8 KB · Đọc: 16
Lần chỉnh sửa cuối:
donvinhhp đã viết:
E chào bác! E cũng đang gặp trường hợp giống bạn đang thắc mắc, e có làm theo hướng dẫn của bác, thì việc lấy dữ liệu từ File Access vào Excel đã thực hiện được, nhưng có 1 chút vấn đề, đó là bảng dữ liệu bên Access khi e đưa sang Excel thì toàn bộ các bảng đều mất đi phần đầu danh mục trên cùng, mong bác giúp e với, thực sự e ko biết gì về VBA, e chỉ mò mẫm theo hướng dẫn của các bác trên này để tự làm. E chân thành cảm ơn!
Đây là đoạn code e tự chế, bác xem giúp e xem e sai ở đâu ạ?



E có đính kèm ảnh, phần tiêu đề trên cùng mất hết!
Lưu ý là khi e dùng chức năng import external data của excel vào thì phần tiêu đề dòng trên cùng còn nguyên chứ ko bị mất!
Nhấp chuột vào đây để mở rộng...
Bạn phải đổ dữ liệu bắt đầu vào Cell A2, Từ Cell A1 bạn phải thêm 1 động tác nữa là lấy tiêu đề cột của bảng ghi lên đó.
 
Hai Lúa Miền Tây đã viết:
Bạn phải đổ dữ liệu bắt đầu vào Cell A2, Từ Cell A1 bạn phải thêm 1 động tác nữa là lấy tiêu đề cột của bảng ghi lên đó.
Nhấp chuột vào đây để mở rộng...
E đã thay A1 thành A2, thì dữ liệu copy chuyển xuống 1 dòng được rồi ạ, e ko biết code để copy tiêu đề bên trên, bác giúp e đoạn code đó với, e cảm ơn!
 
donvinhhp đã viết:
E đã thay A1 thành A2, thì dữ liệu copy chuyển xuống 1 dòng được rồi ạ, e ko biết code để copy tiêu đề bên trên, bác giúp e đoạn code đó với, e cảm ơn!
Nhấp chuột vào đây để mở rộng...
Chỉ cần tạo 1 biến mở Recordset là đủ. Tôi tạm chỉnh code của bạn như sau:

Mã: 
Public Sub GetDataBase()
    Dim Db As Object
    Dim Rs As Object
    Dim AccPath As String
    Dim i As Integer
    AccPath = Application.GetOpenFilename("TEXT FILES(*.mdb),*.mdb")
    Set Db = MyDAO(AccPath)
    Set Rs = Db.OpenRecordset("Frame Sections")
    With Sheets("Frame Sections")
        .Columns("A:V").Delete
        For i = 0 To Rs.Fields.Count - 1
            .Cells(1, i + 1) = Rs.Fields(i).Name
        Next
        .Range("A2").CopyFromRecordset Rs
    End With
    Rs.Close
    Set Rs = Db.OpenRecordset("Frame Assignments - Summary")
    With Sheets("Frame Assignments- Summary")
        .Columns("A:V").Delete
        For i = 0 To Rs.Fields.Count - 1
            .Cells(1, i + 1) = Rs.Fields(i).Name
        Next
        .Range("A2").CopyFromRecordset Rs
    End With
    Rs.Close
    Set Rs = Db.OpenRecordset("Column Forces")
    With Sheets("Column Forces")
        .Columns("A:V").Delete
        For i = 0 To Rs.Fields.Count - 1
            .Cells(1, i + 1) = Rs.Fields(i).Name
        Next
        .Range("A2").CopyFromRecordset Rs
    End With
    Sheets("ThepCot").Select
    Range("A1").Select
End Sub
 
Hai Lúa Miền Tây đã viết:
Chỉ cần tạo 1 biến mở Recordset là đủ. Tôi tạm chỉnh code của bạn như sau:
Nhấp chuột vào đây để mở rộng...
E đã test và thấy đoạn code bác thêm vào hoạt động tốt, toàn bộ phần tiêu đề giờ đã xuất hiện, e đang cố đọc code để hiểu
nguyên đoạn code này là để chừa lại dòng trên cùng nhập tên đúng ko bác:
For i = 0 To Rs.Fields.Count - 1
.Cells(1, i + 1) = Rs.Fields(i).Name
Next
Nhấp chuột vào đây để mở rộng...
E chân thành cảm ơn bác nhé!
 
donvinhhp đã viết:
E đã test và thấy đoạn code bác thêm vào hoạt động tốt, toàn bộ phần tiêu đề giờ đã xuất hiện, e đang cố đọc code để hiểu
nguyên đoạn code này là để chừa lại dòng trên cùng nhập tên đúng ko bác:

E chân thành cảm ơn bác nhé!
Nhấp chuột vào đây để mở rộng...
Nôm na là khi đổ dữ liệu từ Recordset xuống sheet thì mặc định nó không có tiêu đề cột. Muốn có tiêu đề cột thì bạn phải đọc cái tiêu đề cột trong bảng và ghi xuống sheet. Những dòng code trên có ý nghĩa như thế.
 
Hai Lúa Miền Tây đã viết:
Nôm na là khi đổ dữ liệu từ Recordset xuống sheet thì mặc định nó không có tiêu đề cột. Muốn có tiêu đề cột thì bạn phải đọc cái tiêu đề cột trong bảng và ghi xuống sheet. Những dòng code trên có ý nghĩa như thế.
Nhấp chuột vào đây để mở rộng...
Hic, có chút vấn đề bác ơi, giờ thì vấn đề nhập dữ liệu từ Access sang Excel ok rùi, nhưng khi e nhấn lệnh nhập dữ liệu xong, thì toàn bộ những công thức ở các sheet khác, mà e lấy số liệu từ sheet vừa nhập dữ liệu xong ý bị mất địa chỉ ô toàn bộ, kiểu như hình e gửi kèm ý ạ! Bác giúp e với! E cảm ơn!
 

File đính kèm

  • Minh hoa 1.jpg
    Minh hoa 1.jpg
    5.8 KB · Đọc: 5
  • File loi.rar
    246.9 KB · Đọc: 4
donvinhhp đã viết:
Hic, có chút vấn đề bác ơi, giờ thì vấn đề nhập dữ liệu từ Access sang Excel ok rùi, nhưng khi e nhấn lệnh nhập dữ liệu xong, thì toàn bộ những công thức ở các sheet khác, mà e lấy số liệu từ sheet vừa nhập dữ liệu xong ý bị mất địa chỉ ô toàn bộ, kiểu như hình e gửi kèm ý ạ! Bác giúp e với! E cảm ơn!
Nhấp chuột vào đây để mở rộng...
Tôi nghĩ bạn đã xóa cả cột A->V nên gặp vấn đề là đúng rồi mà

Đoạn sau:

Mã: 
Columns("A:V").Delete
 
Hai Lúa Miền Tây đã viết:
Tôi nghĩ bạn đã xóa cả cột A->V nên gặp vấn đề là đúng rồi mà

Đoạn sau:

Mã: 
Columns("A:V").Delete
[/QUOTE]
Nhấp chuột vào đây để mở rộng...
E ko hiểu lắm, e chỉ nghĩ đơn giản là, File này e dùng chung cho nhiều số liệu khác nhau nhập từ 1 file access, nên mỗi lần nhập số liệu mới thì phải xóa số liệu cũ đi, e cứ nghĩ là nó ko ảnh hưởng đến các sheet công thức bên cạnh ??? vậy có cách nào giữ được công thức các sheet khác ko ạ?
Bài đã được tự động gộp:

Hai Lúa Miền Tây đã viết:
Tôi nghĩ bạn đã xóa cả cột A->V nên gặp vấn đề là đúng rồi mà

Đoạn sau:

Mã: 
Columns("A:V").Delete
Nhấp chuột vào đây để mở rộng...
E vừa xóa dòng đó đi và chạy lại, may quá ko bị lỗi gì ạ!
 
donvinhhp đã viết:
E ko hiểu lắm, e chỉ nghĩ đơn giản là, File này e dùng chung cho nhiều số liệu khác nhau nhập từ 1 file access, nên mỗi lần nhập số liệu mới thì phải xóa số liệu cũ đi, e cứ nghĩ là nó ko ảnh hưởng đến các sheet công thức bên cạnh ??? vậy có cách nào giữ được công thức các sheet khác ko ạ?
Bài đã được tự động gộp:


E vừa xóa dòng đó đi và chạy lại, may quá ko bị lỗi gì ạ!
Nhấp chuột vào đây để mở rộng...
Bạn thử sửa:

Mã: 
.Columns("A:V").clearcontents
 
Hai Lúa Miền Tây đã viết:
Tôi nghĩ bạn đã xóa cả cột A->V nên gặp vấn đề là đúng rồi mà

Đoạn sau:

Mã: 
Columns("A:V").Delete
Nhấp chuột vào đây để mở rộng...
Nhân đây, bác giúp e chút vấn đề này nữa nhé! File excel e gửi bên trên, có sheet(BxH), sheet này là e nhặt số liệu từ các sheet vừa nhập dữ liệu ban đầu, bác viết giúp e đoạn code sao chép hàng loạt dòng xuống tương ứng với số dòng của bên sheet(Column forces) ý ạ, nghĩa là bên sheet(Column forces) có bao nhiêu dòng thì bên sheet(BxH) tự động copy xuống từng đó dòng ý ạ! E xin chân thành cảm ơn bác!
Bài đã được tự động gộp:

Hai Lúa Miền Tây đã viết:
Bạn thử sửa:

Mã: 
.Columns("A:V").clearcontents
Nhấp chuột vào đây để mở rộng...
E sửa theo thế thì thì ok luôn rồi ạ! E cảm ơn bác!
Bài đã được tự động gộp:

Hai Lúa Miền Tây đã viết:
Bạn thử sửa:

Mã: 
.Columns("A:V").clearcontents
Nhấp chuột vào đây để mở rộng...
Đây là đoạn code trước e cóp nhặt và chế ra, nhưng là giới hạn số dòng copy, e ko biết cách để nó tự phát hiện xem sheet(column force) bao nhiêu dòng thì nó tự kéo xuống bấy nhiêu dòng ý ạ, bác sửa giúp e với!
Sub ThepCotM22()
Sheets("ThepCot").Select
Range("A11").Select
ActiveCell.Formula = "='Column Forces'!A2"
Range("B11").Select
ActiveCell.Formula = "='Column Forces'!B2"
Range("C11").Select
ActiveCell.Formula = "='Column Forces'!D2"
Range("D11").Select
ActiveCell.Formula = "=abs('Column Forces'!J2)"
Range("E11").Select
ActiveCell.Formula = "=abs('Column Forces'!F2)"
Range("F11").Select
ActiveCell.Formula = "=VLOOKUP(H11,BxH!A:F,6,0)"
Range("I11").Select
ActiveCell.Formula = "=VLOOKUP(H11,BxH!A:F,2,0)"
Range("J11").Select
ActiveCell.Formula = "=VLOOKUP(H11,BxH!A:F,3,0)"
Range("A11:AP11").Select
Selection.AutoFill Destination:=Range("A11:AP37"), Type:=xlFillCopy
Range("A11:AP37").Select
Range("A11").Select
End Sub
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
donvinhhp đã viết:
Nhân đây, bác giúp e chút vấn đề này nữa nhé! File excel e gửi bên trên, có sheet(BxH), sheet này là e nhặt số liệu từ các sheet vừa nhập dữ liệu ban đầu, bác viết giúp e đoạn code sao chép hàng loạt dòng xuống tương ứng với số dòng của bên sheet(Column forces) ý ạ, nghĩa là bên sheet(Column forces) có bao nhiêu dòng thì bên sheet(BxH) tự động copy xuống từng đó dòng ý ạ! E xin chân thành cảm ơn bác!
Bài đã được tự động gộp:


E sửa theo thế thì thì ok luôn rồi ạ! E cảm ơn bác!
Bài đã được tự động gộp:


Đây là đoạn code trước e cóp nhặt và chế ra, nhưng là giới hạn số dòng copy, e ko biết cách để nó tự phát hiện xem sheet(column force) bao nhiêu dòng thì nó tự kéo xuống bấy nhiêu dòng ý ạ, bác sửa giúp e với!
Nhấp chuột vào đây để mở rộng...
Rich (BB code): 
Selection.AutoFill Destination:=Range("A11:AP37"), Type:=xlFillCopy
Bạn thay số tôi tô đỏ bằng số tương ứng của bạn nhé. Hiện tại nó chỉ fill xuống đến dòng 37
 
Hai Lúa Miền Tây đã viết:
Rich (BB code): 
Selection.AutoFill Destination:=Range("A11:AP37"), Type:=xlFillCopy
Bạn thay số tôi tô đỏ bằng số tương ứng của bạn nhé. Hiện tại nó chỉ fill xuống đến dòng 37
Nhấp chuột vào đây để mở rộng...
Dạ, ý e là sheet(Column Force) có thể có nhiều hơn số hàng đó (hiện giờ file e đang làm là có từng ấy hàng ạ), nghĩa là số hàng là ko biết trước, trường hợp sheet(Column Force) có tầm 123 hàng (chẳng hạn), thì việc để cho code tự phát hiện có bao nhiêu hàng để nó tự động copy xuống hàng cuối cùng của sheet(Column Force) liệu có khả thi ko ạ? E cảm ơn!
 
donvinhhp đã viết:
Dạ, ý e là sheet(Column Force) có thể có nhiều hơn số hàng đó (hiện giờ file e đang làm là có từng ấy hàng ạ), nghĩa là số hàng là ko biết trước, trường hợp sheet(Column Force) có tầm 123 hàng (chẳng hạn), thì việc để cho code tự phát hiện có bao nhiêu hàng để nó tự động copy xuống hàng cuối cùng của sheet(Column Force) liệu có khả thi ko ạ? E cảm ơn!
Nhấp chuột vào đây để mở rộng...
Bạn phải xác định được số dòng của sheet đó trước rồi tra nó vào. Có rất là nhiều cách nhưng tôi chỉ nói cách sau:

Mã: 
Sub test()
   dim i as integer
   i=Sheets("Column Forces").Range("A1").SpecialCells(xlCellTypeLastCell).Row
    MsgBox i
End Sub
Tra biến i vào chỗ tôi tô đỏ ở bài trước nhé
 
Hai Lúa Miền Tây đã viết:
Bạn phải xác định được số dòng của sheet đó trước rồi tra nó vào. Có rất là nhiều cách nhưng tôi chỉ nói cách sau:

Mã: 
Sub test()
   dim i as integer
   i=Sheets("Column Forces").Range("A1").SpecialCells(xlCellTypeLastCell).Row
    MsgBox i
End Sub
Tra biến i vào chỗ tôi tô đỏ ở bài trước nhé
Nhấp chuột vào đây để mở rộng...
Dạ, nghĩa là muốn copy xuống, kiểu gì vẫn phải qua bước đếm xem Sheets("Column Forces") có bao nhiêu hàng đã ạ?
Sau đó ứng với từng File cụ thể thì mình sẽ sửa code để máy tự động chạy xuống từng đó dòng ạ?
E cảm ơn bác!
 
donvinhhp đã viết:
Dạ, nghĩa là muốn copy xuống, kiểu gì vẫn phải qua bước đếm xem Sheets("Column Forces") có bao nhiêu hàng đã ạ?
Sau đó ứng với từng File cụ thể thì mình sẽ sửa code để máy tự động chạy xuống từng đó dòng ạ?
E cảm ơn bác!
Nhấp chuột vào đây để mở rộng...
Đúng rồi bạn, mình phải xác định được số dòng tương ứng trước chứ. Bạn có thể xác định nó khi lấy dữ liệu

Mã: 
Public Sub GetDataBase()
    Dim Db As Object
    Dim Rs As Object
    Dim AccPath As String
    Dim i As Integer
    Dim sodong As Integer
    AccPath = Application.GetOpenFilename("TEXT FILES(*.mdb),*.mdb")
    Set Db = MyDAO(AccPath)
    Set Rs = Db.OpenRecordset("Frame Sections")
    With Sheets("Frame Sections")
        .Columns("A:V").ClearContents
        For i = 0 To Rs.Fields.Count - 1
            .Cells(1, i + 1) = Rs.Fields(i).Name
        Next
        sodong = Rs.RecordCount + 1
        MsgBox "So dong cua sheet [Frame Sections] la: " & sodong
        .Range("A2").CopyFromRecordset Rs
    End With
    Rs.Close
    Set Rs = Db.OpenRecordset("Frame Assignments - Summary")
    With Sheets("Frame Assignments- Summary")
        .Columns("A:V").ClearContents
        For i = 0 To Rs.Fields.Count - 1
            .Cells(1, i + 1) = Rs.Fields(i).Name
        Next
        sodong = Rs.RecordCount + 1
        MsgBox "So dong cua sheet [Frame Assignments- Summary] la: " & sodong
        .Range("A2").CopyFromRecordset Rs
    End With
    Rs.Close
    Set Rs = Db.OpenRecordset("Column Forces")
    With Sheets("Column Forces")
        .Columns("A:V").ClearContents
        For i = 0 To Rs.Fields.Count - 1
            .Cells(1, i + 1) = Rs.Fields(i).Name
        Next
        sodong = Rs.RecordCount + 1
        MsgBox "So dong cua sheet [Column Forces] la: " & sodong
        .Range("A2").CopyFromRecordset Rs
    End With
    Sheets("ThepCot").Select
    Range("A1").Select
End Sub
 
Rút gọn code trên lại một chút. Lưu ý tên bảng phải giống tên sheet nhé.

Mã: 
Public Sub GetDataBase()
    Dim Db As Object, Rs As Object
    Dim AccPath As String, TenSheet As String
    Dim i As Integer, SoDong As Integer, iSht As Integer
    Dim arrTenSheet As Variant
    arrTenSheet = Array("Frame Sections", "Frame Assignments - Summary", "Column Forces")
    AccPath = Application.GetOpenFilename("TEXT FILES(*.mdb),*.mdb")
    Set Db = MyDAO(AccPath)
    For iSht = 0 To 2
        TenSheet = arrTenSheet(iSht)
        Set Rs = Db.OpenRecordset(TenSheet)
        With Sheets(TenSheet)
            .Columns("A:V").ClearContents
            For i = 0 To Rs.Fields.Count - 1
                .Cells(1, i + 1) = Rs.Fields(i).Name
            Next
            SoDong = Rs.RecordCount + 1
            MsgBox "So dong cua sheet " & TenSheet & " la: " & SoDong
            .Range("A2").CopyFromRecordset Rs
        End With
        Rs.Close
    Next
    Sheets("ThepCot").Select
    Range("A1").Select
End Sub
 
Hai Lúa Miền Tây đã viết:
Đúng rồi bạn, mình phải xác định được số dòng tương ứng trước chứ. Bạn có thể xác định nó khi lấy dữ liệu

Mã: 
Public Sub GetDataBase()
    Dim Db As Object
    Dim Rs As Object
    Dim AccPath As String
    Dim i As Integer
    Dim sodong As Integer
    AccPath = Application.GetOpenFilename("TEXT FILES(*.mdb),*.mdb")
    Set Db = MyDAO(AccPath)
    Set Rs = Db.OpenRecordset("Frame Sections")
    With Sheets("Frame Sections")
        .Columns("A:V").ClearContents
        For i = 0 To Rs.Fields.Count - 1
            .Cells(1, i + 1) = Rs.Fields(i).Name
        Next
        sodong = Rs.RecordCount + 1
        MsgBox "So dong cua sheet [Frame Sections] la: " & sodong
        .Range("A2").CopyFromRecordset Rs
    End With
    Rs.Close
    Set Rs = Db.OpenRecordset("Frame Assignments - Summary")
    With Sheets("Frame Assignments- Summary")
        .Columns("A:V").ClearContents
        For i = 0 To Rs.Fields.Count - 1
            .Cells(1, i + 1) = Rs.Fields(i).Name
        Next
        sodong = Rs.RecordCount + 1
        MsgBox "So dong cua sheet [Frame Assignments- Summary] la: " & sodong
        .Range("A2").CopyFromRecordset Rs
    End With
    Rs.Close
    Set Rs = Db.OpenRecordset("Column Forces")
    With Sheets("Column Forces")
        .Columns("A:V").ClearContents
        For i = 0 To Rs.Fields.Count - 1
            .Cells(1, i + 1) = Rs.Fields(i).Name
        Next
        sodong = Rs.RecordCount + 1
        MsgBox "So dong cua sheet [Column Forces] la: " & sodong
        .Range("A2").CopyFromRecordset Rs
    End With
    Sheets("ThepCot").Select
    Range("A1").Select
End Sub
Nhấp chuột vào đây để mở rộng...
E cảm ơn bác nhiều!
 
Hai Lúa Miền Tây đã viết:
Rút gọn code trên lại một chút. Lưu ý tên bảng phải giống tên sheet nhé.

Mã: 
Public Sub GetDataBase()
    Dim Db As Object, Rs As Object
    Dim AccPath As String, TenSheet As String
    Dim i As Integer, SoDong As Integer, iSht As Integer
    Dim arrTenSheet As Variant
    arrTenSheet = Array("Frame Sections", "Frame Assignments - Summary", "Column Forces")
    AccPath = Application.GetOpenFilename("TEXT FILES(*.mdb),*.mdb")
    Set Db = MyDAO(AccPath)
    For iSht = 0 To 2
        TenSheet = arrTenSheet(iSht)
        Set Rs = Db.OpenRecordset(TenSheet)
        With Sheets(TenSheet)
            .Columns("A:V").ClearContents
            For i = 0 To Rs.Fields.Count - 1
                .Cells(1, i + 1) = Rs.Fields(i).Name
            Next
            SoDong = Rs.RecordCount + 1
            MsgBox "So dong cua sheet " & TenSheet & " la: " & SoDong
            .Range("A2").CopyFromRecordset Rs
        End With
        Rs.Close
    Next
    Sheets("ThepCot").Select
    Range("A1").Select
End Sub
Nhấp chuột vào đây để mở rộng...
E giờ mới để ý thấy bác giúp e rút gọn lại code!
E vừa chạy thử, code báo cho số dòng, nhưng bị lỗi như trong ảnh ạ!
Với lại bác ko cần sửa lỗi này nữa đâu ạ, trước khi chạy code e để ý số dòng cũng được!
Có điều, e nhớ cũng lâu rồi, cách đây 3, 4 năm gì đó, có lần e xem trên mạng có đoạn code cho phép copy (thay cho thao tác bôi đen hàng trên (như bảng của e là bôi đen row(11:11), sau đó đặt chuột vào dấu cộng màu đen rồi kéo xuống, đến khi nào đến dòng cuối của sheet("Column Forces") thì dừng lại), kiểu như có code để tự động phát hiện ra dòng cuối của sheet("Column Forces") ý ạ!
E có tìm trong File hồi xưa, có đoạn code thế này, bác xem giúp e ko biết có phải là nó ko?
Rows("11:11").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Nhấp chuột vào đây để mở rộng...
E xin chân thành cảm ơn sự nhiệt tình của bác!
 

File đính kèm

  • Loi1.jpg
    Loi1.jpg
    72.8 KB · Đọc: 9
donvinhhp đã viết:
E giờ mới để ý thấy bác giúp e rút gọn lại code!
E vừa chạy thử, code báo cho số dòng, nhưng bị lỗi như trong ảnh ạ!
Với lại bác ko cần sửa lỗi này nữa đâu ạ, trước khi chạy code e để ý số dòng cũng được!
Có điều, e nhớ cũng lâu rồi, cách đây 3, 4 năm gì đó, có lần e xem trên mạng có đoạn code cho phép copy (thay cho thao tác bôi đen hàng trên (như bảng của e là bôi đen row(11:11), sau đó đặt chuột vào dấu cộng màu đen rồi kéo xuống, đến khi nào đến dòng cuối của sheet("Column Forces") thì dừng lại), kiểu như có code để tự động phát hiện ra dòng cuối của sheet("Column Forces") ý ạ!
E có tìm trong File hồi xưa, có đoạn code thế này, bác xem giúp e ko biết có phải là nó ko?

E xin chân thành cảm ơn sự nhiệt tình của bác!
Nhấp chuột vào đây để mở rộng...
Dùng xlDown bạn lưu ý là dữ liệu của bạn phải liên tục, không có ô nào bị trống nhé.

1622163867604.png
Còn nếu không thì thêm 1 mảng tên sheet rồi duyệt chung với bảng tương ứng là được.
 
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

V
Tách chuỗi bất kỳ vào các cột khi gặp ký tự -
Trả lời
5
Đọc
131
DeTong
D
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
Trả lời
19
Đọc
283
Emyeuexcel
Emyeuexcel
1
Xin hỗ trợ về tính tổng các dòng loại trừ dòng ẩn nhưng các dòng không liền nhau
Trả lời
3
Đọc
49
198zxc
1
Q
trả lời google form bằng VBA excel
Trả lời
1
Đọc
33
befaint
befaint
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
6
Đọc
147
phammaihuong90
phammaihuong90
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom