chia table access (1 người xem)

thang314 · 22/2/12

nhờ ACE giúp đỡ code export 1 table trong access sang nhiều file excel cùng định dạng với điều kiện file excel có số dòng nhất định.
ví dụ file access của em có table DK có 1002 record muốn chia thành các file excel có dữ liệu tại sheet1 ví dụ như DK1.xls có 300 dòng, DK2.xls có 300 dòng... đến hết record trong table. thanks ACE nhiều

Hai Lúa Miền Tây · 28/2/12

thang314 đã viết:
nhờ ACE giúp đỡ code export 1 table trong access sang nhiều file excel cùng định dạng với điều kiện file excel có số dòng nhất định.
ví dụ file access của em có table DK có 1002 record muốn chia thành các file excel có dữ liệu tại sheet1 ví dụ như DK1.xls có 300 dòng, DK2.xls có 300 dòng... đến hết record trong table. thanks ACE nhiều

Đề tài cũng khá hay.
Sau khi được sự hướng dẫn của Thầy Ptm0412 mình xin được post trả lời như sau:

Tạm thời xuất chung 1 file excel, mỗi 1 sheet theo điều kiện của bạn như trên là 300rst

Mã:

Option Compare Database

Private Sub Command0_Click()
Dim db As DAO.Database, rs As DAO.Recordset, mySQL As String, iNumCols As Integer, rowIdx As Integer, countRows As Integer, iRows As Integer
Dim oApp As New Excel.Application, oBook As Excel.Workbook, oSheet As Excel.Worksheet
Dim ShCount As Long
    Set oBook = oApp.Workbooks.Add
    mySQL = "select * from tbldata"

    Set db = CurrentDb
    Set rs = db.OpenRecordset(mySQL, dbOpenSnapshot)
        rs.MoveLast
        rs.MoveFirst
        iNumCols = rs.Fields.Count
        iRows = rs.RecordCount
        Label6.Visible = True
        Label5.Visible = True
    
    Set oSheet = oBook.ActiveSheet

    For rowIdx = 0 To iRows - 1
        If rowIdx = ShCount * 300 Then
            ShCount = ShCount + 1
            RowInput = 5
            oBook.Sheets.Add
            Set oSheet = oBook.ActiveSheet
            oSheet.Name = "Sh" & ShCount
            Label6.Caption = "Sh" & ShCount
            For i = 1 To iNumCols
              With oSheet
                .Cells(RowInput, i).Value = rs.Fields(i - 1).Name
                .Cells(RowInput, i).Font.Bold = True
                .Cells(RowInput, i).Font.ColorIndex = 5
                .Cells(RowInput, i).Interior.ColorIndex = 34
              End With
            Next
         End If
          RowInput = RowInput + 1
          oSheet.Columns.AutoFit
       For Cols = 0 To rs.Fields.Count - 1
            oSheet.Cells(RowInput, Cols + 1).Value = rs(Cols).Value
            Text3 = rs(Cols).Value
       Next
        rs.MoveNext
    
    Next
    
    Label6.Caption = ShCount & " Sht"
    Label5.Caption = ChrW(272) & "ã t" & ChrW(7841) & "o xong d" & ChrW(7919) & " li" & ChrW(7879) & "u là :"
    rs.Close
    oApp.Visible = True
    db.Close
    
    
End Sub

Tuy nhiên tốc độ còn hạn chế, Thầy Mỹ sẽ nghiên cứu cải thiện giúp.
Bạn xem file nhé.

ptm0412 · 28/2/12

Code Dom gán từng giá trị của record xuống từng cell nên chậm quá; 15 giây.
Sử dụng mảng nhanh hơn, 2.25 giây

PHP:

Sub test2()
Dim db As DAO.Database, rs As DAO.Recordset, mySQL As String
Dim iRows As Integer, iNumCols As Integer, rowIdx As Integer
Dim oApp As New Excel.Application, oBook As Excel.Workbook, oSheet As Excel.Worksheet
Dim ShCount As Long, RowInput As Long
Dim ReArr()
    t = Timer
    Set oBook = oApp.Workbooks.Add
    mySQL = "select * from tbldata"

    Set db = CurrentDb
    Set rs = db.OpenRecordset(mySQL, dbOpenSnapshot)
        rs.MoveLast
        rs.MoveFirst
        iNumCols = rs.Fields.Count
        iRows = rs.RecordCount
        ReDim ReArr(1 To 300, 1 To iNumCols)
    
    For rowIdx = 0 To iRows - 1
          RowInput = RowInput + 1
       For Cols = 0 To rs.Fields.Count - 1
            ReArr(RowInput, Cols + 1) = rs(Cols).Value
       Next
        rs.MoveNext
        If RowInput = 300 Or rs.EOF Then
            ShCount = ShCount + 1
            oBook.Sheets.Add
            Set oSheet = oBook.ActiveSheet
            oSheet.Name = "Ptm" & ShCount
            Label6.Caption = "Ptm" & ShCount
            For i = 1 To iNumCols
              With oSheet
                .Cells(5, i).Value = rs.Fields(i - 1).Name
                .Cells(5, i).Font.Bold = True
                .Cells(5, i).Font.ColorIndex = 5
                .Cells(5, i).Interior.ColorIndex = 34
              End With
            Next

            oSheet.Cells(6, 1).Resize(RowInput, iNumCols).Value = ReArr
            oSheet.Columns.AutoFit
            ReDim ReArr(1 To 300, 1 To iNumCols)
            RowInput = 0
        End If
    Next
    
    Label6.Caption = ShCount & " Sheets"
    Label5.Caption = ChrW(272) & "ã t" & ChrW(7841) & "o xong d" & ChrW(7919) & " li" & ChrW(7879) & "u là :"
    Erase ReArr
    rs.Close
    db.Close
    MsgBox Timer - t
    For Each sh In oBook.Sheets
        If Left(sh.Name, 3) <> "Ptm" Then sh.Delete
    Next
    oApp.Visible = True
    
End Sub

thang314 · 29/2/12

code của domfootwear và ptm0412 đều khá hay tốc độ cao, tuy nhiên vẫn chưa đạt được yêu cầu. nguyên nhân: tách 1 sheet thành nhiều sheet trong cùng 1 file.
hiện tại em đã làm được theo cách tạo query truy vấn: query1 lấy 300 dòng đầu, query2 lấy 300 dòng tiếp theo và sử dụng commondialog.save để lưu tên file, tuy nhiên có một cái mắc là nếu trong 1 table có quá nhiều dòng thì phải tạo ra nhiều query. có cách nào khắc phục được không?( bằng cách tạo biến trong query chằng hạn)

ptm0412 · 29/2/12

Một file nhiều sheet hay nhiều file chỉ cần thay 1 câu lệnh.

Còn code tạo query của bạn đâu? sao không đưa lên xem có thể dùng biến hoặc vòng lặp gì không?

thang314 · 29/2/12

tạm thời em chưa làm được file=> bác thông cảm.
query1:
SELECT TOP 300 tbldata.ID, tbldata.i_date, tbldata.[q'ty], tbldata.remarks
FROM tbldata
WHERE Tbldata.id;
query2:
SELECT TOP 300 tbldata.ID, tbldata.i_date, tbldata.[q'ty], tbldata.remarks
FROM tbldata
WHERE tbldata.id NOT IN(select top 300 tbldata.id from tbldata);
query3:
SELECT TOP 300 tbldata.ID, tbldata.i_date, tbldata.[q'ty], tbldata.remarks
FROM tbldata
WHERE tbldata.id NOT IN(select top 600 tbldata.id from tbldata);
v.v

thang314 · 29/2/12

em gọi query để tạo file rồi export ra excel
rivate Sub Command3_Click()
On Error GoTo Err_Command3_Click
Dim objExcel As New Excel.Application
Dim ObjWorkbook As Workbook
Dim objWorksheet As Worksheet
Rec.Close
Rec.Open "select * from " & Combo1.List(Combo1.ListIndex)
Set DataGrid1.DataSource = Rec
Dim Mang As Variant
Mang = Rec.GetRows(-1, 1)
Set ObjWorkbook = objExcel.Workbooks.Add()
Set objWorksheet = ObjWorkbook.Worksheets("sheet1")
objExcel.Visible = False
For c = LBound(Mang, 1) To UBound(Mang, 1)
objWorksheet.Cells(1, c + 1).Value = Rec.Fields(c).Name
Next
For r = LBound(Mang, 2) To UBound(Mang, 2)
For c = LBound(Mang, 1) To UBound(Mang, 1)
objWorksheet.Cells(r + 2, c + 1).Value = Mang(c, r)
Next c
Next r
With CommonDialog1
.ShowSave
ObjWorkbook.SaveAs CommonDialog1.FileName
ObjWorkbook.Close
MsgBox "Luu file thanh cong, mo file tai " & CommonDialog1.FileName, , "Thong bao"
End With
Exit_Command3_Click:
Exit Sub
Err_Command3_Click:
MsgBox "Co loi trong qua trinh Export, Kiem tra ten file luu va nhan Save", vbCritical, "Thong bao"
Resume Exit_Command3_Click
End Sub

ThuNghi · 29/2/12

ptm0412 đã viết:
Code Dom gán từng giá trị của record xuống từng cell nên chậm quá; 15 giây.
Sử dụng mảng nhanh hơn, 2.25 giây

Hay quá mà e chả hiểu gì cả, mở từ file Acc hay Ex vậy.
Mở ra, bảo nhập ?? vào Cell dữ liệu.
Nhờ các Bác chỉ giúp. Cám ơn.

Hai Lúa Miền Tây · 29/2/12

Mình dùng hàm partition để tách sau đó lọc dữ liệu ra.
Nhưng phải tạo ra 2 query, 1 listbox, 1 textbox để gõ số dòng theo ý muốn.
Code như sau:

Mã:

Sub domfootwear()
Dim db As DAO.Database, rs As DAO.Recordset, mySQL As String
Dim oApp As New Excel.Application, oBook As Excel.Workbook, oSheet As Excel.Worksheet
Dim RowInput As Long, i As Integer, iNumCols As Integer
Dim frm As Form, ctl As Control
    t = Timer
    Set oBook = oApp.Workbooks.Add

Dim varItm As Variant
Set frm = Forms![form1]
Set ctl = frm!lstDK
For Each varItm In ctl.ItemsSelected
    
    mySQL = "SELECT tblData.ID, tblData.I_DATE, tblData.[Q'TY], tblData.REMARKS " & _
            "FROM tblData " & _
            "WHERE (((Partition([id],1,(select top 1 id from tblData order by id DESC)," & txtRec & ")) like '" & ctl.ItemData(varItm) & "'));"
    Set db = CurrentDb
    Set rs = db.OpenRecordset(mySQL, dbOpenSnapshot)
    iNumCols = rs.Fields.Count
    
    oBook.Sheets.Add
    Set oSheet = oBook.ActiveSheet
        oSheet.Name = "Dom " & Replace(ctl.ItemData(varItm), ":", " To ")
            For i = 1 To iNumCols
              With oSheet
                .Cells(5, i).Value = rs.Fields(i - 1).Name
                .Cells(5, i).Font.Bold = True
                .Cells(5, i).Font.ColorIndex = 5
                .Cells(5, i).Interior.ColorIndex = 34
              End With
            Next

        oSheet.Range("A6").CopyFromRecordset rs
        oSheet.Columns.AutoFit
        ctl.Selected(varItm) = False
        
Next varItm
    MsgBox Timer - t
    For Each sh In oBook.Sheets
        If Left(sh.Name, 3) <> "Dom" Then sh.Delete
    Next
    oApp.Visible = True
    rs.Close
    db.Close

End Sub


Private Sub Form_Load()
txtRec = 300
lstDK.Requery
End Sub


Private Sub txtRec_AfterUpdate()
lstDK.Requery
End Sub

Tuy nhiên so với tốc độ Arr thì thua nhiều
Nhờ bạn test thử.

thang314 · 29/2/12

một cách hay, tuy nhiên khi đặt ID là biến chạy thì sao?

ptm0412 · 29/2/12

ThuNghi đã viết:
Hay quá mà e chả hiểu gì cả, mở từ file Acc hay Ex vậy.
Mở ra, bảo nhập ?? vào Cell dữ liệu.
Nhờ các Bác chỉ giúp. Cám ơn.

Không chạy được, không biết mở dữ liệu từ đâu, mà khen hay!
Chả biết khen hay chửi nữa!

Table gốc là của Access, open recordset, sau đó dùng vòng lặp duyệt qua tất cả các record, mỗi record dùng 1 vòng lặp duyệt qua các fields, gán giá trị vào Array. Array đủ 300 dòng thì tạo sheet gán xuống. ReDim Array để xoá dữ liệu cũ của Array, gán lại giá trị từ đầu.

Hai Lúa Miền Tây · 29/2/12

thang314 đã viết:
một cách hay, tuy nhiên khi đặt ID là biến chạy thì sao?

Chưa hiểu ý bạn, túm lại bài toán của bạn có được giải quyết chưa? Nếu chưa thì bạn phải miêu tả ý muốn 1 cách rõ ràng, bạn không chịu đưa file tôi phải giả lập file. Bầy giờ bạn hỏi 1 cách cụt ngủn... hỏng hiểu gì hết.

thang314 · 29/2/12

domfootwear đã viết:
Chưa hiểu ý bạn, túm lại bài toán của bạn có được giải quyết chưa? Nếu chưa thì bạn phải miêu tả ý muốn 1 cách rõ ràng, bạn không chịu đưa file tôi phải giả lập file. Bầy giờ bạn hỏi 1 cách cụt ngủn... hỏng hiểu gì hết.

sory bác, đã test xong,không vấn đề gì, tại em chỉ xem có mỗi q_dk1. thanks bác nhiều. chắc lần này em phải đi học lập trình quá.

Hai Lúa Miền Tây · 29/2/12

Như bài trên dư ra 1 biến RowInput, và tên sheet Thầy Mỹ góp ý nên bỏ hết khoảng trắng thay " To " thành "-" code như sau:

Mã:

Sub domfootwear()
Dim db As DAO.Database, rs As DAO.Recordset, mySQL As String
Dim oApp As New Excel.Application, oBook As Excel.Workbook, oSheet As Excel.Worksheet
Dim i As Integer, iNumCols As Integer
Dim frm As Form, ctl As Control
    t = Timer
    Set oBook = oApp.Workbooks.Add

Dim varItm As Variant
Set frm = Forms![form1]
Set ctl = frm!lstDK
For Each varItm In ctl.ItemsSelected
  
    mySQL = "SELECT tblData.ID, tblData.I_DATE, tblData.[Q'TY], tblData.REMARKS " & _
            "FROM tblData " & _
            "WHERE (((Partition([id],1,(select top 1 id from tblData order by id DESC)," & txtRec & ")) like '" & ctl.ItemData(varItm) & "'));"
    Set db = CurrentDb
    Set rs = db.OpenRecordset(mySQL, dbOpenSnapshot)
    iNumCols = rs.Fields.Count
    
    oBook.Sheets.Add
    Set oSheet = oBook.ActiveSheet
        oSheet.Name = "Dom" & Replace(Trim(ctl.ItemData(varItm)), ":", "-")
            For i = 1 To iNumCols
              With oSheet
                .Cells(5, i).Value = rs.Fields(i - 1).Name
                .Cells(5, i).Font.Bold = True
                .Cells(5, i).Font.ColorIndex = 5
                .Cells(5, i).Interior.ColorIndex = 34
              End With
            Next

        oSheet.Range("A6").CopyFromRecordset rs
        oSheet.Columns.AutoFit
        ctl.Selected(varItm) = False
        
Next varItm
    MsgBox Timer - t
    For Each sh In oBook.Sheets
        If Left(sh.Name, 3) <> "Dom" Then sh.Delete
    Next
    oApp.Visible = True
    rs.Close
    db.Close

End Sub


Private Sub Form_Load()
txtRec = 300
lstDK.Requery
End Sub


Private Sub txtRec_AfterUpdate()
lstDK.Requery
End Sub

Hai Lúa Miền Tây · 29/2/12

Sẵn trớn làm luôn cho bạn 2 lựa chọn xuất file: Chung 1file và tách ra từng file (Lưu chung những file đó vào 1 folder)

Code như sau:

Mã:

Sub domfootwear2()
Dim db As DAO.Database, rs As DAO.Recordset, mySQL As String
Dim oApp As New Excel.Application, oBook As Excel.Workbook, oSheet As Excel.Worksheet
Dim i As Integer, iNumCols As Integer
Dim frm As Form, ctl As Control
    t = Timer
    Set oBook = oApp.Workbooks.Add

Dim varItm As Variant
Set frm = Forms![form1]
Set ctl = frm!lstDK
For Each varItm In ctl.ItemsSelected
    mySQL = "SELECT tblData.ID, tblData.I_DATE, tblData.[Q'TY], tblData.REMARKS " & _
            "FROM tblData " & _
            "WHERE (((Partition([id],1,(select top 1 id from tblData order by id DESC)," & txtRec & ")) like '" & ctl.ItemData(varItm) & "'));"
    Set db = CurrentDb
    Set rs = db.OpenRecordset(mySQL, dbOpenSnapshot)
    iNumCols = rs.Fields.Count
    If Frame9.Value = 1 Then
        Set oBook = oApp.Workbooks.Add
        
      Else
        oBook.Sheets.Add
    End If
    Set oSheet = oBook.ActiveSheet
        oSheet.Name = "Dom" & Replace(Trim(ctl.ItemData(varItm)), ":", "-")
            For i = 1 To iNumCols
              With oSheet
                .Cells(5, i).Value = rs.Fields(i - 1).Name
                .Cells(5, i).Font.Bold = True
                .Cells(5, i).Font.ColorIndex = 5
                .Cells(5, i).Interior.ColorIndex = 34
              End With
            Next

        oSheet.Range("A6").CopyFromRecordset rs
        oSheet.Columns.AutoFit
        ctl.Selected(varItm) = False
    If Frame9.Value = 1 Then
           oBook.SaveAs CurrentProject.Path & "\" & "Dom" & Replace(Trim(ctl.ItemData(varItm)), ":", "-")
        For Each sh In oBook.Sheets
            If Left(sh.Name, 3) <> "Dom" Then sh.Delete
        Next
        oBook.Close (True)
    End If

Next varItm
    MsgBox Timer - t
    
    If Frame9.Value = 2 Then
        oApp.Visible = True
        For Each sh In oBook.Sheets
            If Left(sh.Name, 3) <> "Dom" Then sh.Delete
        Next
    End If
    rs.Close
    db.Close

End Sub

ThuNghi · 29/2/12

ptm0412 đã viết:
Không chạy được, không biết mở dữ liệu từ đâu, mà khen hay!
Chả biết khen hay chửi nữa!

Table gốc là của Access, open recordset, sau đó dùng vòng lặp duyệt qua tất cả các record, mỗi record dùng 1 vòng lặp duyệt qua các fields, gán giá trị vào Array. Array đủ 300 dòng thì tạo sheet gán xuống. ReDim Array để xoá dữ liệu cũ của Array, gán lại giá trị từ đầu.

Em dùng thử ADO cũng nhanh kg kém. Học lóm là nghề của e mà.
Arr=GetRows...

PHP:

Option Compare Database
Sub GetArr01()
Dim i&, j&, mySQL$, iR&
Dim Arr(), ReArr()
Dim oApp As New Excel.Application, oBook As Excel.Workbook, oSheet As Excel.Worksheet
Dim ShCount As Long, RowInput As Long, T
Dim Cn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
 T = Timer
Cn.Open "Provider = Microsoft.Jet.OLEDB.4.0;" & "Data Source = e:\chiabang.mdb"
mySQL = "select * from tbldata"
Rs.Open mySQL, Cn, adOpenStatic, adLockOptimistic
Arr = Rs.GetRows '(-1, 1)
Set oBook = oApp.Workbooks.Add
ReDim ReArr(1 To UBound(Arr, 2) + 1, 1 To UBound(Arr, 1) + 1)
iR = 0: ShCount = 0
ReDim ReArr(1 To 300, 1 To UBound(Arr, 1) + 1)
For j = 0 To UBound(Arr, 2)
  iR = iR + 1
  For i = 0 To UBound(Arr, 1)
    ReArr(iR, i + 1) = Arr(i, j)
  Next i
  If iR = 300 Then
    iR = 0
    ShCount = ShCount + 1
    oBook.Sheets.Add
    Set oSheet = oBook.ActiveSheet
    oSheet.Name = "Ptm" & ShCount
    oSheet.[A1].Resize(3000, 4) = ReArr
    ReDim ReArr(1 To 300, 1 To UBound(Arr, 1) + 1)
  End If
Next j
Rs.Close
Cn.Close
Set oBook = Nothing
MsgBox Timer - T
oApp.Visible = True
End Sub

Hai Lúa Miền Tây · 29/2/12

ThuNghi đã viết:

Em dùng thử ADO cũng nhanh kg kém. Học lóm là nghề của e mà.
Arr=GetRows...

PHP:

Option Compare Database
Sub GetArr01()
Dim i&, j&, mySQL$, iR&
Dim Arr(), ReArr()
Dim oApp As New Excel.Application, oBook As Excel.Workbook, oSheet As Excel.Worksheet
Dim ShCount As Long, RowInput As Long, T
Dim Cn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
 T = Timer
Cn.Open "Provider = Microsoft.Jet.OLEDB.4.0;" & "Data Source = e:\chiabang.mdb"
mySQL = "select * from tbldata"
Rs.Open mySQL, Cn, adOpenStatic, adLockOptimistic
Arr = Rs.GetRows '(-1, 1)
Set oBook = oApp.Workbooks.Add
ReDim ReArr(1 To UBound(Arr, 2) + 1, 1 To UBound(Arr, 1) + 1)
iR = 0: ShCount = 0
ReDim ReArr(1 To 300, 1 To UBound(Arr, 1) + 1)
For j = 0 To UBound(Arr, 2)
  iR = iR + 1
  For i = 0 To UBound(Arr, 1)
    ReArr(iR, i + 1) = Arr(i, j)
  Next i
  If iR = 300 Then
    iR = 0
    ShCount = ShCount + 1
    oBook.Sheets.Add
    Set oSheet = oBook.ActiveSheet
    oSheet.Name = "Ptm" & ShCount
    oSheet.[A1].Resize(3000, 4) = ReArr
    ReDim ReArr(1 To 300, 1 To UBound(Arr, 1) + 1)
  End If
Next j
Rs.Close
Cn.Close
Set oBook = Nothing
MsgBox Timer - T
oApp.Visible = True
End Sub

Ta chỉ cần dùng CurrentProject.Connection cho 1 file hiện hành, khỏi khai báo kết nối anh à.

Mã:

Dim i&, j&, mySQL$, iR&
Dim Arr(), ReArr()
Dim oApp As New Excel.Application, oBook As Excel.Workbook, oSheet As Excel.Worksheet
Dim ShCount As Long, RowInput As Long, T
[COLOR=#008000]'Dim Cn As New ADODB.Connection[/COLOR]
Dim Rs As New ADODB.Recordset
 T = Timer
[COLOR=#008000]'Cn.Open "Provider = Microsoft.Jet.OLEDB.4.0;" & "Data Source = e:\chiabang.mdb"[/COLOR]
mySQL = "select * from tbldata"
Rs.Open mySQL, [COLOR=#008000]CurrentProject.Connection[/COLOR], adOpenStatic, adLockOptimistic
Arr = Rs.GetRows(-1, 1)
Set oBook = oApp.Workbooks.Add
ReDim ReArr(1 To UBound(Arr, 2) + 1, 1 To UBound(Arr, 1) + 1)
iR = 0: ShCount = 0
ReDim ReArr(1 To 300, 1 To UBound(Arr, 1) + 1)
For j = 0 To UBound(Arr, 2)
  iR = iR + 1
  For i = 0 To UBound(Arr, 1)
    ReArr(iR, i + 1) = Arr(i, j)
  Next i
  If iR = 300 Then
    iR = 0
    ShCount = ShCount + 1
    oBook.Sheets.Add
    Set oSheet = oBook.ActiveSheet
    oSheet.Name = "Ptm" & ShCount
    oSheet.[A1].Resize([COLOR=#ff0000]3000[/COLOR], 4) = ReArr
    ReDim ReArr(1 To 300, 1 To UBound(Arr, 1) + 1)
  End If
Next j
Rs.Close
[COLOR=#008000]'Cn.Close[/COLOR]
Set oBook = Nothing
MsgBox Timer - T
oApp.Visible = True

Code trên dư dòng thừa bên dưới và thiếu 172 dòng dữ liệu.

ptm0412 · 29/2/12

Code ThuNghi chạy từ Excel mà Dom, hắn làm biếng ghi rõ lắm.

Tuy vậy, còn 1 vài lỗi:
- ReArr 300 dòng mà gán xuống sheet 3000 dòng (từ 301 trở đi bị NA#)
- Chưa có sheet cuối vì chỉ mới có If iR = 300, chưa có EOF, thiếu 172 records.

ThuNghi · 1/3/12

ptm0412 đã viết:
Code ThuNghi chạy từ Excel mà Dom, hắn làm biếng ghi rõ lắm.

Tuy vậy, còn 1 vài lỗi:
- ReArr 300 dòng mà gán xuống sheet 3000 dòng (từ 301 trở đi bị NA#)
- Chưa có sheet cuối vì chỉ mới có If iR = 300, chưa có EOF, thiếu 172 records.

Cám ơn Bác và Dom
Chuyện NA và 172 dòng thì "not big"

PHP:

If iR = 300 Or j = UBound(Arr, 2) Then

Và

PHP:

oSheet.[A1].Resize(iR, 4) = ReArr

Là OK.
Học thêm chiêu từ Dom

PHP:

Rs.Open mySQL, CurrentProject.Connection, adOpenStatic, adLockOptimistic

Là lấy data tại file hiện hành.

thang314 · 2/3/12

sao trong vb6 khi gọi dòng mySQL thì không được nhỉ bác Dom, mặc dù em vẫn gán txtREC bằng form!formname!controls.
mySQL = "SELECT tk.ACCOUNT_ID, tk.CR_NAME, tk.CR_AMOUNT, tk.DB_AMOUNT " & _
"FROM tk " & _
"WHERE (((Partition([stt],1,(select top 1 stt from tk order by stt DESC)," & Form!Form12!txtRec & ")) like '" & ctl.ItemData(varItm) & "'));"
báo runtime error 424 object required. kiểm tra mySQL =nothing

chia table access (1 người xem)

Người dùng đang xem chủ đề này

Thành viên thường trực

❆❆❆❆❆❆❆❆

File đính kèm

Bad Excel Member

File đính kèm

Thành viên thường trực

Bad Excel Member

Thành viên thường trực

Thành viên thường trực

Hãy cho rồi sẽ nhận!

❆❆❆❆❆❆❆❆

File đính kèm

Thành viên thường trực

Bad Excel Member

❆❆❆❆❆❆❆❆

Thành viên thường trực

❆❆❆❆❆❆❆❆

❆❆❆❆❆❆❆❆

File đính kèm

Hãy cho rồi sẽ nhận!

❆❆❆❆❆❆❆❆

Bad Excel Member

Hãy cho rồi sẽ nhận!

Thành viên thường trực

Đếm ngược thời gian