• Trang chủ click to expand contents 

  • Xuất dữ liệu từ Access ra Excel theo điều kiện

  • Xuất dữ liệu từ Access ra Excel theo điều kiện

    Minh Tiên > 11-04-18, 09:31 AM

    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, 09:15 AM

    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, 04:09 PM

    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, 09:35 PM

    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, 09:24 AM

    - 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 Integer, iColXuat As Integer, iSoDongDaxuat As Integer
       Dim iSoField     As Integer, iSoTrang As Integer
       Dim iSoDongDaXuatPhai     As Integer, iSoDongDaXuatTrai As Integer, iRowXuatPhai 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(iRowXuat, iColXuat + 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(iRowXuat, iColXuat + iColStart + iSoField + 1).Value = rst.Fields(iColXuat)
                   Next iColXuat
                   iRowXuatPhai     = iRowXuat
               End With

                   'Xuat trang ke tiep: Cot Trai'
           ElseIf Int((iSoDongDaxuat - 1 + iSoDongTrangKe - iSoDongTrang1 * 2) / iSoDongTrangKe) Mod 2 <> 0 Then
               iRowXuat     = iRowXuatPhai + 1 + 1
               iRowXuat     = iRowXuat + iSoDongDaXuatTrai
               With oExcelWrSht
                   For iColXuat     = 0 To iSoField - 1
                           .Cells(iRowXuat, iColXuat + 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 - 1 + iSoDongTrangKe - iSoDongTrang1 * 2) / iSoDongTrangKe) Mod 2 = 0 Then
               iRowXuat     = iRowXuat + 1

               With oExcelWrSht
                   For iColXuat     = 0 To iSoField - 1
                           .Cells(iRowXuat, iColXuat + 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, 03:06 PM

    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, 11:05 AM

    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, 11:21 AM

    (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, 11:20 AM

    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, 01:55 PM

    (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