Thủ Thuật Access
Xuất dữ liệu từ Access ra Excel theo điều kiện - Phiên bản có thể in

+- Thủ Thuật Access (http://thuthuataccess.com/forum)
+-- Diễn đàn: Access Nâng Cao (http://thuthuataccess.com/forum/forum-11.html)
+--- Diễn đàn: Thủ thuật VBA (http://thuthuataccess.com/forum/forum-17.html)
+--- Chủ đề: Xuất dữ liệu từ Access ra Excel theo điều kiện (/thread-10469.html)

Pages: 1 2


Xuất dữ liệu từ Access ra Excel theo điều kiện - Minh Tiên - 11-04-18

Tiên có bài toán xuất dữ liệu từ Access ra Excel theo yêu cầu:
1. Xuất trang 1:
- Nội dung ghi vào cột A, B: 2 dòng (gồm Stt và Nội dung. Bắt đầu từ Cell A1) (Xuất bên trái);
- Nội dung ghi vào cột D, E: 2 dòng (gồm Stt và Nội dung. Bắt đầu từ Cell D1) (Xuất bên phải);
Ngắt trang

2. Xuất từ trang 2 trở đi:
- Nội dung ghi vào cột A, B: 5 dòng (gồm Stt và Nội dung. Bắt đầu từ Cell A4) (Xuất bên trái);
- Nội dung ghi vào cột D, E: 5 dòng (gồm Stt và Nội dung. Bắt đầu từ Cell D4) (Xuất bên phải);
Ngắt trang;
Và cứ luôn phiên xuất trái, phải ...
- Xuất trái 5 dòng ..
- Xuất phải 5 dòng ...

(Có data kèm theo: DataXuatExcel)
Nhờ A/C/E Pro chỉ giáo giúp. Thanks !


RE: Xuất dữ liệu từ Access ra Excel theo điều kiện - ongke0711 - 12-04-18

Tôi đang test thử cách tiếp cận là: kiểm tra số dòng thuộc trang chẳn hay lẻ để tách cột. Trang 1 thì dễ rồi.


RE: Xuất dữ liệu từ Access ra Excel theo điều kiện - Minh Tiên - 12-04-18

Tiên cũng đã thử nhiều kiểu: Theo phân trang, nếu là trang 1 thì, ... trang 2 thì, ...; Theo số dòng đã xuất, ... Set lại dòng xuất, ...
Kết quả nếu xuất trái 10 dòng, xuất phải 20 dòng jj đó, rồi xuất sang trái, ... luân  phiên từ trên xuống thì OK.
Còn muốn:
- Trang 1: Xuất bên trái 10 dòng tại Cell A1 --> Xuất phải 10 dòng tại Cell D1
- Trang 2: Xuất trái 20 dòng tại Cell A12 --> Xuất phải 20 dòng tại Cell D12
thì bí, vẫn chưa thực hiện được. Khi set vị trí xuất về Cell yêu cầu, Chương trình cứ báo lỗi.

Nhờ các ACE Pro chỉ giáo giúp !
Thanks !


RE: Xuất dữ liệu từ Access ra Excel theo điều kiện - DooHoaangPhuuc - 12-04-18

Cháu nghĩ có nên xuất dữ liệu như thế ra từng Sheet (Sheet1, Sheet2, Sheet3, .......,)  trong Exel Workbook thì chắc dễ dàng hơn vì mỗi Sheet khi in ấn cũng tương đương từng trang in .


RE: Xuất dữ liệu từ Access ra Excel theo điều kiện - ongke0711 - 14-04-18

- Hiện tại code này thì chỉ mới xuất ra được như vậy: bạn có thực sự cần thêm khoảng trắng giữa các trang sau không? Đang ngâm cứu thêm cách làm khác.
- Số dòng trang 1: 2 dòng , trang 2: 3 dòng là tùy chọn khai báo hằng trong code.

[Hình: 39632116690_c67983a44b_o.png]

Mã PHP:
Option Compare Database
Option Explicit


Private Sub btnXuatExcel_Click()

   Dim oExcel As Object
   Dim oExcelWrkBk 
As Object
   Dim oExcelWrSht 
As Object
   Dim bExcelOpened 
As Boolean
   Set oExcel 
GetObject("""Excel.Application")
   If Err.Number <> 0 Then
       Err
.Clear
       Set oExcel 
CreateObject("Excel.Application")
       bExcelOpened False
   Else
       bExcelOpened 
True
   End 
If
   Set oExcelWrkBk oExcel.Workbooks.Add()
   Set oExcelWrSht oExcelWrkBk.Sheets(1)
   oExcel.Visible True

   Const iRowStart 
As Integer 1  'Bat dau ô A1'
   Const iColStart As Integer 1
   Const iSoDongTrang1 
As Integer 2   'So dòng o trang thu 1'
   Const iSoDongTrangKe As Integer 3  'So dòng o cac trang ke tiep, giong nhau'

   Dim iRowXuat As IntegeriColXuat As IntegeriSoDongDaxuat As Integer
   Dim iSoField 
As IntegeriSoTrang As Integer
   Dim iSoDongDaXuatPhai 
As IntegeriSoDongDaXuatTrai As IntegeriRowXuatPhai As Integer

   Dim rst 
As DAO.Recordset
   Set rst 
CurrentDb.OpenRecordset("SELECT * FROM table1 ORDER BY Stt;")

   If rst.RecordCount 0 Then
       rst
.MoveFirst
   Else
       MsgBox 
"Khong có du lieu."
       Exit Sub
   End 
If

   iSoField rst.Fields.Count
   iRowXuat 
iRowStart
   iSoDongDaxuat 
0
   Do 
While Not rst.EOF
       iSoDongDaxuat 
iSoDongDaxuat 1

       
'XuatTrai:'
       If iSoDongDaxuat <= iSoDongTrang1 Then
           With oExcelWrSht
               For iColXuat 
0 To iSoField 1
                   
.Cells(iRowXuatiColXuat iColStart).Value rst.Fields(iColXuat)
               Next iColXuat
           End With
           iRowXuat 
iRowXuat 1

           
'XuatPhai:'
       ElseIf iSoDongDaxuat iSoDongTrang1 And iSoDongDaxuat <= iSoDongTrang1 2 Then
           iRowXuat 
iSoDongDaxuat iSoDongTrang1
           With oExcelWrSht
               For iColXuat 
0 To iSoField 1
                   
.Cells(iRowXuatiColXuat iColStart iSoField 1).Value rst.Fields(iColXuat)
               Next iColXuat
               iRowXuatPhai 
iRowXuat
           End With

           
'Xuat trang ke tiep: Cot Trai'
       ElseIf Int((iSoDongDaxuat iSoDongTrangKe iSoDongTrang1 2) / iSoDongTrangKeMod 2 <> 0 Then
           iRowXuat 
iRowXuatPhai 1
           iRowXuat 
iRowXuat iSoDongDaXuatTrai
           With oExcelWrSht
               For iColXuat 
0 To iSoField 1
                   
.Cells(iRowXuatiColXuat iColStart).Value rst.Fields(iColXuat)
               Next iColXuat
               iSoDongDaXuatTrai 
iSoDongDaXuatTrai 1
           End With

           
'Xuat trang ke tiep: Cot Phai'
           iRowXuat iSoDongDaXuatTrai iSoDongTrangKe iSoDongTrang1 1
       ElseIf Int
((iSoDongDaxuat iSoDongTrangKe iSoDongTrang1 2) / iSoDongTrangKeMod 2 0 Then
           iRowXuat 
iRowXuat 1

           With oExcelWrSht
               For iColXuat 
0 To iSoField 1
                   
.Cells(iRowXuatiColXuat iColStart iSoField 1).Value rst.Fields(iColXuat)
               Next iColXuat
               iSoDongDaXuatPhai 
iSoDongTrangKe
           End With

       End 
If
       rst.MoveNext
   Loop


   rst
.Close
   oExcel
.Visible True
   Set oExcelWrSht 
Nothing
   Set oExcelWrkBk 
Nothing
   Set oExcel 
Nothing

End Sub 



RE: Xuất dữ liệu từ Access ra Excel theo điều kiện - Minh Tiên - 17-04-18

Thanks ongke0711 !
Mình đang rất cần các dòng trống này để làm việc khác xen vào !
Thân./.


RE: Xuất dữ liệu từ Access ra Excel theo điều kiện - Minh Tiên - 24-04-18

Tiên đã làm được rồi. Xin chia sẽ code:
Mã:
Private Sub btnXuatExcel_Click()
       
   Dim oExcel As Object
  Dim oExcelWrkBk As Object
  Dim oExcelWrSht As Object
  Dim bExcelOpened As Boolean
  Set oExcel = GetObject("", "Excel.Application")
  If Err.Number <> 0 Then
      Err.Clear
      Set oExcel = CreateObject("Excel.Application")
      bExcelOpened = False
  Else
      bExcelOpened = True
  End If
  Set oExcelWrkBk = oExcel.Workbooks.Add()
  Set oExcelWrSht = oExcelWrkBk.Sheets(1)
  oExcel.Visible = True
'===================================================
   Const DongTrang1 As Long = 3     'So dong xuat trong Trang 1
   Const DongTrangN As Long = 5    'So dong xuat trong Trang N
   
   Dim Trang As Integer                       'De giam sat trang 1 hay trang N
   Dim DongTrang As Integer              'De giam sat da xuat bao nhieu dong trong trang (Thiet lap ve 1 cho moi trang)
   
   Dim DongXuatTrai As Integer         'Vi tri bat dau xuat ben Trai moi trang
   Dim DongXuatPhai As Integer        'Vi tri bat dau xuat ben Phai moi trang
   
   Trang = 1
   DongTrang = 0
'====================================================

   Dim sql As String
   Dim rst As Recordset
   sql = "SELECT Stt, Noidung FROM table1 ORDER BY Stt;"
   Set rst = CurrentDb.OpenRecordset(sql)
   If rst.RecordCount > 0 Then
       rst.MoveFirst
       DongXuatTrai = 1
       DongXuatPhai = 1
       Do Until rst.EOF
           
           If Trang = 1 Then
               If DongTrang < DongTrang1 Then
'XUAT TRAI TRANG 1:
                   With oExcelWrSht
                       .Cells(DongXuatTrai, 1).Value = rst!Stt
                       .Cells(DongXuatTrai, 2).Value = rst!Noidung
                   End With
                   DongXuatTrai = DongXuatTrai + 1
                   DongTrang = DongTrang + 1
               Else
'XUAT PHAI TRANG 1:
                   If DongTrang < DongTrang1 * 2 Then
                       With oExcelWrSht
                           .Cells(DongXuatPhai, 3).Value = rst!Stt
                           .Cells(DongXuatPhai, 4).Value = rst!Noidung
                       End With
                       DongXuatPhai = DongXuatPhai + 1
                       DongTrang = DongTrang + 1
                   Else
                       Trang = Trang + 1
                       DongXuatTrai = DongTrang1 + 2
                       DongXuatPhai = DongTrang1 + 2
                       DongTrang = 0
                       GoTo XuatTraiTrangN
                   End If
               End If
           Else
'XUAT TRAI TRANG 2,3, ...:
XuatTraiTrangN:
               If DongTrang < DongTrangN Then
                   With oExcelWrSht
                       .Cells(DongXuatTrai, 1).Value = rst!Stt
                       .Cells(DongXuatTrai, 2).Value = rst!Noidung
                   End With
                   DongXuatTrai = DongXuatTrai + 1
                   DongTrang = DongTrang + 1
               Else
'XUAT PHAI TRANG 2,3, ...:
XuatPhaiTrangN:
                   If DongTrang < DongTrangN * 2 Then
                       With oExcelWrSht
                           .Cells(DongXuatPhai, 3).Value = rst!Stt
                           .Cells(DongXuatPhai, 4).Value = rst!Noidung
                       End With
                       DongXuatPhai = DongXuatPhai + 1
                       DongTrang = DongTrang + 1
                   Else
                       Trang = Trang + 1
                       DongXuatTrai = DongTrang1 + 1 + DongTrangN * (Trang - 2) + (Trang - 1)
                       DongXuatPhai = DongTrang1 + 1 + DongTrangN * (Trang - 2) + (Trang - 1)
                       DongTrang = 0
                       GoTo XuatTraiTrangN
                   End If
               End If
           End If
       rst.MoveNext
       Loop
   End If
   
End Sub
Demo:Demo


RE: Xuất dữ liệu từ Access ra Excel theo điều kiện - ongke0711 - 24-04-18

(24-04-18, 11:05 AM)Minh Tiên Đã viết: Tiên đã làm được rồi. Xin chia sẽ code:

Thumbs_up Thumbs_up Clap Bữa giờ tôi chưa nghĩ ra.


RE: Xuất dữ liệu từ Access ra Excel theo điều kiện - xuatquanvosau - 25-05-18

Các bạn thân mến. Tôi có gặp vấn đề hơi khác 1 chút mong các bạn giúp. Tôi tạo 1 button. Khi tôi bấm vào nó thì access sẽ mở 1 file excel PTVH_25-05-2018.xlsx do 1 người A khác đã chuẩn bị nội dung sẵn, đến sheet 1, tại vị trí dưới dòng chữ IV. Nội dung công tác: đúng 5 row, tụt sang phải đúng 1 column, copy 1 mảng đúng 8 column dài 94 row, sau đó mở file excel PTVH_xx-xx-2018.xlsx, đến sheet 1, row 6 column 2 rồi dán mảng đấy vào, xong rồi lưu file và thoát. Code tôi soạn thô thiển như sau 014

Mã:
Private Sub Command37_Click()
   Dim tenfileptvh As String
   tenfileptvh = "PTVH_" & Format(Now() + 1, "dd-mm-yyyy") & ".xlsx"
   Dim taptinptvh As String
   taptinptvh = "N:\TO PHUONG THUC NGAN\PHUONG THUC VAN HANH NGAY " & Format(Now() + 1, "yyyy") & "\THANG " & Format(Now() + 1, "mm") & "\" & tenfileptvh
   
   Dim tenfileptvhxx As String
   tenfileptvhxx = "PTVH_xx-xx-2018.xlsx"
   Dim taptinptvhxx As String
   taptinptvhxx = "X:\Yen\AccessSanPham\tailieucuadieudo\2Xem\08PhuongThucNgay\" & tenfileptvhxx
         
   Dim xlApp As Object
   Set xlApp = CreateObject("Excel.Application")
   Dim xlBook1 As Object
   Dim xlBook2 As Object
   Set xlBook1 = xlApp.Workbooks.Open(taptinptvhxx)
   Set xlBook2 = xlApp.Workbooks.Open(taptinptvh)
   Dim xlSheet1 As Object
   Dim xlSheet2 As Object
   Set xlSheet1 = xlBook1.Worksheets(1)
   Set xlSheet2 = xlBook2.Worksheets(1)
     
   With xlSheet1
   xlBook1.Worksheets(1).Range("A6:J100").Value = xlBook2.Worksheets(1).Range("A64:J158").Value
   End With
   
   xlBook1.Save
   xlBook1.Saved = True
   xlBook2.Saved = True
   xlApp.Quit
   
   MsgBoxTimeout 0, "Xong!", "App. Of Op.", vbInformation, 0, 1000
End Sub

Đến đó thì button chạy tốt. Nhưng hàng ngày anh A nhập liệu vào file PTVH_25-05-2018.xlsx nên tọa độ mảng mình muốn copy nó cứ thay đổi, Range("A64:J158") cứ phải vào sửa lại bằng tay, ví dụ sửa thành Range("A63:J157"), khi thì Range("A62:J156")... làm mất sướng khi bấm vào button đó

Mong các vị đại hiệp giúp đỡ tôi sửa code thế nào để khi anh A nhập liệu cỡ nào đi nữa thì ta chỉ cần bấm nút là copy được mảng ta mong muốn. Mảng này lúc nào cũng ở tại vị trí dưới dòng chữ IV. Nội dung công tác: đúng 5 row, tụt sang phải đúng 1 column, copy 1 mảng đúng 8 column dài 94 row

Trân trọng cám ơn quý vị!


RE: Xuất dữ liệu từ Access ra Excel theo điều kiện - ongke0711 - 25-05-18

(25-05-18, 11:20 AM)xuatquanvosau Đã viết: Đến đó thì button chạy tốt. Nhưng hàng ngày anh A nhập liệu vào file PTVH_25-05-2018.xlsx nên tọa độ mảng mình muốn copy nó cứ thay đổi, Range("A64:J158") cứ phải vào sửa lại bằng tay, ví dụ sửa thành Range("A63:J157"), khi thì Range("A62:J156")... làm mất sướng khi bấm vào button đó

Mong các vị đại hiệp giúp đỡ tôi sửa code thế nào để khi anh A nhập liệu cỡ nào đi nữa thì ta chỉ cần bấm nút là copy được mảng ta mong muốn. Mảng này lúc nào cũng ở tại vị trí dưới dòng chữ IV. Nội dung công tác: đúng 5 row, tụt sang phải đúng 1 column, copy 1 mảng đúng 8 column dài 94 row

Trân trọng cám ơn quý vị!

Nếu như cái mảng của bạn không thay đổi thì bạn đặt thuộc tính "Name" cho nó sau đó tham chiếu đến cái Name này trong code là được rồi. Sau khi dặt Name cho một Range nào đó thì dù có thêm dòng, xoá dòng thì địa chỉ của cái Name đó cũng cập nhật theo. 
Vd: 
- File PTVH_25-05-2018.xlsx, Range("A64:J158") bạn đặt tên (Name) là: "Address2"
- File PTVH _xx-xx-2018.xlsx, Range nào đó mà bạn muốn copy đến, đặt tên là: "Address1"
- Code cho việc copy toàn bộ cái range đã dặt tên:

Mã PHP:
xlBook2.Names("Address2").RefersToRange.Copy xlBook1.Names("Address1").RefersToRange