Tùy chọn
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
-
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]](https://farm1.staticflickr.com/794/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:
Demo:DemoMã: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 -
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
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
Bữa giờ tôi chưa nghĩ ra.