Đố vui về ADO, DAO.

hungpecc1 · 18/6/13

Hai Lúa Miền Tây đã viết:
Ví dụ tôi có 2 Workbook A.xls và B.xls, làm thế nào ở WB A.xls tôi có thể ghi dữ liệu vào WB B.xls như hình bên dưới.

WB A.xls:

View attachment 104076

WB B.xls

View attachment 104077

Xin cảm ơn.

Anh cho em hỏi, :
*câu hỏi của anh là :ghi sheetB có sẵn trong B.xls hay là tự tạo một sheet mới rồi ghi vào !

Hai Lúa Miền Tây · 18/6/13

dhn46 đã viết:
Anh cho em hỏi: có được phép đặt sẵn f2, f3 tại B1, D1 SheetB Workbook B không anh?

Không được phép thêm vào anh à.

hungpecc1 đã viết:
Anh cho em hỏi, :
*câu hỏi của anh là :ghi sheetB có sẵn trong B.xls hay là tự tạo một sheet mới rồi ghi vào !

Ghi lên sheetB có sẵn trong B.xls bạn à.

Hai Lúa Miền Tây · 19/6/13

Không biết các bạn Dhn46, Hungpecc1, VieHoai ... đã tìm ra câu trả lời cho bài này chưa?

hungpecc1 · 19/6/13

Hai Lúa Miền Tây đã viết:
Không biết các bạn Dhn46, Hungpecc1, VieHoai ... đã tìm ra câu trả lời cho bài này chưa?

chưa anh ah, em ngâm cứu mãi mà không ra, mấy hôm vừa rồi em thử vọc ALTER TABLE trong excel mà chẳng thấy "hiệu ứng " gì cả ! có lẽ hướng này đi vào ngõ cụt rồi !
Để em ngâm cứu đi theo hướng khác +-+-+-+

Hai Lúa Miền Tây · 19/6/13

hungpecc1 đã viết:
chưa anh ah, em ngâm cứu mãi mà không ra, mấy hôm vừa rồi em thử vọc ALTER TABLE trong excel mà chẳng thấy "hiệu ứng " gì cả ! có lẽ hướng này đi vào ngõ cụt rồi !
Để em ngâm cứu đi theo hướng khác

Gợi ý cho bạn: Bạn hãy đi theo hướng chèn dữ liệu bình thường sẽ ra, đừng suy nghĩ phức tạp quá nhé.

dhn46 · 19/6/13

Hai Lúa Miền Tây đã viết:
Không biết các bạn Dhn46, Hungpecc1, VieHoai ... đã tìm ra câu trả lời cho bài này chưa?

Em mạnh dạn đưa ra đáp án đầu tiên, anh xem và góp ý nhé.

Mã:

Option Explicit
Sub CopyDL()
    Dim i As Long, Target As String
    Dim cnn As Object, lsSQL As String, lrs As Object
    For i = 1 To 2
        Set cnn = CreateObject("ADODB.Connection")
        Set lrs = CreateObject("ADODB.Recordset")
        If i = 1 Then
            Target = ThisWorkbook.Path & "\B.XLS"
            lsSQL = "CREATE TABLE [sheetB$] (f1 char(100), f2 char(100), f4 char(100), f3 float)"
        Else
            Target = ThisWorkbook.FullName
            lsSQL = "INSERT INTO [SheetB$] IN '" & ThisWorkbook.Path & _
                    "\B.xls ' 'Excel 8.0;' SELECT f2, f3 FROM [DataA$A2:C16]"
        End If
        With cnn
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                "Data Source= " & Target & _
                                ";Extended Properties=""Excel 8.0;HDR=No;"";"
            .Open
        End With
        lrs.Open lsSQL, cnn, 3, 1
        Set lrs = Nothing
    Next
End Sub

Hai Lúa Miền Tây · 20/6/13

dhn46 đã viết:

Em mạnh dạn đưa ra đáp án đầu tiên, anh xem và góp ý nhé.

Mã:

Option Explicit
Sub CopyDL()
    Dim i As Long, Target As String
    Dim cnn As Object, lsSQL As String, lrs As Object
    For i = 1 To 2
        Set cnn = CreateObject("ADODB.Connection")
        Set lrs = CreateObject("ADODB.Recordset")
        If i = 1 Then
            Target = ThisWorkbook.Path & "\B.XLS"
            lsSQL = "CREATE TABLE [sheetB$] (f1 char(100), f2 char(100), f4 char(100), f3 float)"
        Else
            Target = ThisWorkbook.FullName
            lsSQL = "INSERT INTO [SheetB$] IN '" & ThisWorkbook.Path & _
                    "\B.xls ' 'Excel 8.0;' SELECT f2, f3 FROM [DataA$A2:C16]"
        End If
        With cnn
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                "Data Source= " & Target & _
                                ";Extended Properties=""Excel 8.0;HDR=No;"";"
            .Open
        End With
        lrs.Open lsSQL, cnn, 3, 1
        Set lrs = Nothing
    Next
End Sub

Có 2 điểm cần lưu ý như sau:

Khi chạy code nó mất hết dòng đầu tiên.
Không được tạo thêm dòng tên cột, xin bật mí chút xíu là hãy dùng cách khác đơn giản mà không cần tạo tiêu đề cột.

hungpecc1 · 21/6/13

Câu đố lần này khó quá ! anh phải gợi ý thêm tẹo nữa để định hướng đi vậy ! -+*/

dhn46 · 21/6/13

Em đông ý với bạn Hungpecc1. Đề lần này khó với việc không tạo tiêu đề cột. Anh gợi ý chit chút nữa, để tụi em tìm kiếm nghiền ngẫm, suy đoán cách làm
Hiểu và ứng dụng ADO sẽ là 1 lợi thế vô cùng lớn. Cảm ơn anh Hai lúa chia sẻ và hướng dẫn. Chúc anh sứ khỏe, thánh công!

Hai Lúa Miền Tây · 22/6/13

hungpecc1 đã viết:
Câu đố lần này khó quá ! anh phải gợi ý thêm tẹo nữa để định hướng đi vậy !

dhn46 đã viết:
Em đông ý với bạn Hungpecc1. Đề lần này khó với việc không tạo tiêu đề cột. Anh gợi ý chit chút nữa, để tụi em tìm kiếm nghiền ngẫm, suy đoán cách làm
Hiểu và ứng dụng ADO sẽ là 1 lợi thế vô cùng lớn. Cảm ơn anh Hai lúa chia sẻ và hướng dẫn. Chúc anh sứ khỏe, thánh công!

Cảm ơn các bạn đã tham gia, xin gợi ý 90% đề bài như sau:

* Mở file B.xls lên, định dạng các cột tương ứng với kiểu dữ liệu cần đưa vào rồi lưu lại là được.

dhn46 · 24/6/13

Hai Lúa Miền Tây đã viết:
Cảm ơn các bạn đã tham gia, xin gợi ý 90% đề bài như sau:

* Mở file B.xls lên, định dạng các cột tương ứng với kiểu dữ liệu cần đưa vào rồi lưu lại là được.

Em mạnh dạn đưa câu trả lời lần 2 dựa trên gợi ý anh HLMT. Anh xem và góp ý nhé

Mã:

Sub ChuyenDL()
    On Error GoTo Handle
    Dim cnn As Object, lsSQL As String, lrs As Object
    Dim WbOpen As Workbook, Sh As Worksheet
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    Application.ScreenUpdating = False
    Set WbOpen = Application.Workbooks.Open(ThisWorkbook.Path & "\B.xls")
    With WbOpen
        For Each Sh In .Worksheets
            If Sh.Name = "SheetB" Then
                Sh.Range("A1:C1").NumberFormat = "@"
                Sh.Range("A1:D1").NumberFormat = "0"
                Exit For
            End If
        Next
        .Save
        .Close
    End With
    Application.ScreenUpdating = True
    With cnn
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                "Data Source=" & ThisWorkbook.FullName & _
                ";Extended Properties=""Excel 8.0;HDR=No;Imex=2"";"
        .Open
    End With
    lsSQL = "INSERT INTO [SheetB$](f2,f4) IN '" & ThisWorkbook.Path & _
            "\B.xls ' 'Excel 8.0;' SELECT f2,f3 FROM [DataA$A1:D16]"
    lrs.Open lsSQL, cnn, 3, 1
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub

hungpecc1 · 24/6/13

dhn46 đã viết:
Em mạnh dạn đưa câu trả lời lần 2 dựa trên gợi ý anh HLMT. Anh xem và góp ý nhé

khôgn biết Có cách nào mà dùng SQL để định dạng dữ liệu ở B.xls không nhỉ ?
vì theo mình nếu mà dùng workbooks.Open thì ta copy luôn dữ liệu vào luôn, cần gì INSERT nữa nhỉ ? --> không biết ý anh HLMT thế nào ?

dhn46 · 24/6/13

hungpecc1 đã viết:
khôgn biết Có cách nào mà dùng SQL để định dạng dữ liệu ở B.xls không nhỉ ?
vì theo mình nếu mà dùng workbooks.Open thì ta copy luôn dữ liệu vào luôn, cần gì INSERT nữa nhỉ ? --> không biết ý anh HLMT thế nào ?

Mình cũng đã nghĩ theo hướng này nhưng quả thực chưa tìm được cách, đành phải "liều" dùng VBA để làm. Không để topic này chìm quá lâu được.

Hai Lúa Miền Tây · 28/6/13

Thật ra các bạn đừng suy nghĩ chi thêm sâu xa, mình đã nói là mở file B.xls ra và định dạng nó, lưu rồi đóng lại = cách thủ công mà không dùng code ấy. Đó là cái "mẹo" để các bạn tự nâng cao "tay nghề" thêm thôi.

Hai Lúa Miền Tây · 4/7/13

Ví dụ dữ liệu của tôi có 100 dòng, bây giờ tôi muốn lấy 10 dòng đầu và 10 dòng cuối trong 1 câu lệnh thì phải làm như thế nào để ra được kết quả như hình.

VetMini · 4/7/13

Theo như dữ liệu trên, có cột ID thì chỉ việc select top 10 order theo ID, union với top 10 order theo ID ngược, xong order lại cho theo ID xuôi.

Không có cột ID thì rất phức tạp. Access không hổ trợ hàm đánh số dòng cho nên phải kèm theo thuật toán đánh số rất rắc rối.

Hai Lúa Miền Tây · 4/7/13

VetMini đã viết:
Theo như dữ liệu trên, có cột ID thì chỉ việc select top 10 order theo ID, union với top 10 order theo ID ngược, xong order lại cho theo ID xuôi.

Vậy bạn thử viết cái Union theo hướng này thử nhé, đó là lý thuyết cái quan trọng là viết như thế nào.

dhn46 · 4/7/13

Em nộp bài

Mã:

Option Explicit
Sub Copy()
    On Error GoTo Handle
    Dim cnn As Object, lsSQL As String, lrs As Object, FileFullName As String
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    FileFullName = Application.ThisWorkbook.FullName
    With cnn
        If Val(Application.Version) < 12 Then
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 12.0;HDR=No"";"
        End If
        .Open
    End With
    lsSQL = "Select f1,f2,f3,f4,'1:10' as col from [Data$A2:D600] where f1<11 union all select f1,f2,f3,f4,'91:100' as col from [Data$A2:D600] where f1>90"
    
    lrs.Open lsSQL, cnn, 3, 1
    Sheet1.[H2:K6000].ClearContents
    Sheet1.Range("H2").CopyFromRecordset lrs
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub

GPE quay quay thoát ra rồi vào mấy lần mới nộp được, híc

Hai Lúa Miền Tây · 4/7/13

Vậy ta không dùng union thì câu lệnh khác sẽ như thế nào?

dhn46 · 4/7/13

Hai Lúa Miền Tây đã viết:
Vậy ta không dùng union thì câu lệnh khác sẽ như thế nào?

Nếu không Union thì như thế này có được không anh

Mã:

    lsSQL = "Select f1,f2,f3,f4,iif(f1<11,'1:10','91:100') as col from [Data$A2:D600] where f1<11 or f1>90"

Đố vui về ADO, DAO.

Thành viên gắn bó

❆❆❆❆❆❆❆❆

❆❆❆❆❆❆❆❆

Thành viên gắn bó

❆❆❆❆❆❆❆❆

Hướng tới tương lai

❆❆❆❆❆❆❆❆

Thành viên gắn bó

Hướng tới tương lai

❆❆❆❆❆❆❆❆

Hướng tới tương lai

Thành viên gắn bó

Hướng tới tương lai

❆❆❆❆❆❆❆❆

❆❆❆❆❆❆❆❆

File đính kèm

Ăn cùng góc phố

❆❆❆❆❆❆❆❆

Hướng tới tương lai

❆❆❆❆❆❆❆❆

Hướng tới tương lai

Facebook

Group