Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Xuất dữ liệu từ Access ra Excel theo điều kiện
#1
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 !
Chữ ký của Minh Tiên -----------------------------------------------
Đường tuy ngắn, không đi không đến
Việc tuy nhỏ, không làm không nên.
                                           Tuân Tử
-----------------------------------------------
Reply
Những người đã cảm ơn
#2
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.
Chữ ký của ongke0711 If you BORN poor, it's not your mistake. But if you DIE poor, It's your mistake!
ღღღღღTài sản của ongke0711 (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#3
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 !
Chữ ký của Minh Tiên -----------------------------------------------
Đường tuy ngắn, không đi không đến
Việc tuy nhỏ, không làm không nên.
                                           Tuân Tử
-----------------------------------------------
Reply
Những người đã cảm ơn
#4
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 .
Chữ ký của DooHoaangPhuuc DooHoaangPhuuc,gia nhập Thủ Thuật Access từ 27-06 -17.
ღღღღღTài sản của DooHoaangPhuuc (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#5
- 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 
Chữ ký của ongke0711 If you BORN poor, it's not your mistake. But if you DIE poor, It's your mistake!
ღღღღღTài sản của ongke0711 (View All Items) ღღღღღ
Reply
Những người đã cảm ơn xuatquanvosau
#6
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./.
Chữ ký của Minh Tiên -----------------------------------------------
Đường tuy ngắn, không đi không đến
Việc tuy nhỏ, không làm không nên.
                                           Tuân Tử
-----------------------------------------------
Reply
Những người đã cảm ơn
#7
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
Chữ ký của Minh Tiên -----------------------------------------------
Đường tuy ngắn, không đi không đến
Việc tuy nhỏ, không làm không nên.
                                           Tuân Tử
-----------------------------------------------
Reply
Những người đã cảm ơn xuatquanvosau
#8
(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.
Chữ ký của ongke0711 If you BORN poor, it's not your mistake. But if you DIE poor, It's your mistake!
ღღღღღTài sản của ongke0711 (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#9
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ị!
Chữ ký của xuatquanvosau
Làm việc từ xa, làm việc tại nhà, làm việc qua mạng để giảm kẹt xe tại Hà Nội và TpHCM  love struck 
Reply
Những người đã cảm ơn
#10
(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 
Chữ ký của ongke0711 If you BORN poor, it's not your mistake. But if you DIE poor, It's your mistake!
ღღღღღTài sản của ongke0711 (View All Items) ღღღღღ
Reply
Những người đã cảm ơn xuatquanvosau


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  [Help] Kết quả tính toán theo dòng record tương ứng tvn_hut 5 339 02-06-18, 03:24 PM
Bài mới nhất: tvn_hut
  [Hỏi] Ghép chuổi trong điều kiện hàm dcount mrsiro 8 433 23-05-18, 10:51 AM
Bài mới nhất: ongke0711
  Thay đổi cỡ Font chữ khi cửa sổ Mesagebox xuất hiện DooHoaangPhuuc 6 354 13-05-18, 02:45 AM
Bài mới nhất: DooHoaangPhuuc
  [Thủ Thuật] Demo Tổng hợp tất cả các kiểu thông báo tiếng việt trong Access maidinhdan 23 6,671 24-04-18, 08:13 PM
Bài mới nhất: DooHoaangPhuuc
  Kẻ khung cell Excel với Access khai báo muộn Minh Tiên 2 179 02-04-18, 08:09 PM
Bài mới nhất: Minh Tiên

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ| PMA Nha Trang| Gỗ Acrylic Không Đường Line