Đố vui về ADO, DAO.

hungpecc1 · 16/7/13

Hai Lúa Miền Tây đã viết:
Tôi có bảng dữ liệu ở sheet1 (STT, Ten, SL, TenWB, TenSheet), do số thứ tự của sheet1 không đồng nhất nên phải đáng STT lại.
Vậy xin hỏi là câu lệnh truy vấn như thế nào sẽ cho ra cột STT đánh theo nhóm (Dựa vào cột TenWB). Kết quả ra ở Sheet2.
Xin cảm ơn.

Em cũng vọc từ hôm qua, nhưng mà so với kết quả ở sheet2 của anh thì khác --> nên chắc là không đúng đáp án +-+-+-+

, nhưng mà đã mất công viết thì cứ post lên thôi :-=

* Cách của bạn Dn46 nhìn tuy gọn , nhưng mà theo em tốc độ code cũng tương đương với cách dùng vòng lặp của em ( do có các câu lệnh select lồng vào nhau )
cụ thể :
[GPECODE=vb]
Sub HLMT()
Dim cnn As Object, rstWB As Object, rstTT As Object
Dim SQL$, i&
Set cnn = CreateObject("ADODB.Connection")
Set rstWB = CreateObject("ADODB.Recordset"): Set rstTT = CreateObject("ADODB.Recordset")
With cnn
.ConnectionString = "Provider=Microsoft.JET.OLEDB.4.0;" & _
"Data source=" & ThisWorkbook.FullName & _
";Extended properties=""excel 8.0;HDR=Yes;IMEX=2"";"
.Open
End With
rstWB.Open "SELECT TenWB FROM [A:E] GROUP BY TenWB", cnn, 3, 1, 1
With rstWB
If .RecordCount > 0 Then
.MoveFirst
While Not .EOF
If Len(rstWB!TenWB) Then
SQL = "SELECT * FROM [A:E] WHERE TenWB='" & rstWB!TenWB & "'"
rstTT.Open SQL, cnn, adOpenStatic, adLockOptimistic, 1
With rstTT
.MoveFirst
i = 1
While Not .EOF
rstTT!STT = i
.MoveNext
i = i + 1
Wend
.Close
End With
End If
.MoveNext
Wend
End If
End With
Set rstTT = Nothing
rstWB.Close: Set rstWB = Nothing
cnn.Close: Set cnn = Nothing
End Sub
[/GPECODE]

^^ code này em sắp xếp trực tiếp trên sheet1 luôn, còn nếu muốn copy từ sheet1 sang sheet2 thì thêm 1 câu lệnh phụ copy nữa !

dhn46 · 16/7/13

Hai Lúa Miền Tây đã viết:
Có 2 vấn đề như sau:

Nếu có n dòng dữ liệu giống nhau thì nó chỉ lấy 1 (Làm sao nếu có n dòng giống nhau thì chỉ lấy 1 nhưng phải cộng cột SL lại)

Cột SL khi ra kết quả phải là dạng số.

Để giải quyết 2 vấn đề trên em xin đưa ra truy vấn sau, anh xem và nhận xét nhé. Cảm ơn anh HLMT

Mã:

        .Open "Select (Select Count(*)+1 from [sheet1$B1:E35] a Where a.TenWb = [sheet1$B1:E35].TenWb And a.Ten<[sheet1$B1:E35].Ten) As STT, " _
             & "Ten, Sum(Val(SL)), TenWb, TenSheet From [sheet1$B1:E35]" _
             & "Group by Ten, TenWb, TenSheet " _
             & "Order by TenWb"

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

dhn46 đã viết:
Để giải quyết 2 vấn đề trên em xin đưa ra truy vấn sau, anh xem và nhận xét nhé. Cảm ơn anh HLMT

Mã:

.Open "Select (Select Count(*)+1 from [sheet1$B1:E35] a Where a.TenWb = [sheet1$B1:E35].TenWb And a.Ten<[sheet1$B1:E35].Ten) As STT, " _ & "Ten, Sum(Val(SL)), TenWb, TenSheet From [sheet1$B1:E35]" _ & "Group by Ten, TenWb, TenSheet " _ & "Order by TenWb"

Kết quả ok nhưng còn 1 chút nữa là thêm 1 điều kiện là các dữ liệu giống nhau mới được group, trường hợp bạn đưa ra thiếu 1 điều kiện group của cột STT.

dhn46 · 16/7/13

Hai Lúa Miền Tây đã viết:
Kết quả ok nhưng còn 1 chút nữa là thêm 1 điều kiện là các dữ liệu giống nhau mới được group, trường hợp bạn đưa ra thiếu 1 điều kiện group của cột STT.

Vâng vậy em chốt lại phương án của em cho câu hỏi lần này:
- Đánh số thự tự theo nhóm, nhóm được tính theo cột TenWB
- Xuất dữ liệu cột SL dạng Number
- Nhóm các hàng có tất cả thông tin trùng nhau (STT,Ten,TenWB,TenSheet) thành 1 số thứ tự và cộng dồn cột SL.

Mã:

Sub STT_Dhn46()
    Set adoConn = CreateObject("ADODB.Connection")
    Set adoRS = CreateObject("ADODB.Recordset")
    With adoConn
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                            "Data Source=" & ThisWorkbook.FullName & _
                            ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
        .Open
    End With
    With adoRS
        .ActiveConnection = adoConn
        .Open "Select (Select Count(*)+1 from [sheet1$A1:E35] a Where a.TenWb = [sheet1$A1:E35].TenWb And a.Ten<[sheet1$A1:E35].Ten) As STT, " _
             & "Ten, Sum(Val(SL)) as SL, TenWb, TenSheet From [sheet1$A1:E35]" _
             & "Group by STT, Ten, TenWb, TenSheet " _
             & "Order by TenWb"
    End With
    With Sheet2
        .[A2:E100].ClearContents
        .[A2].CopyFromRecordset adoRS
    End With
    adoRS.Close: Set adoRS = Nothing
    adoConn.Close: Set adoConn = Nothing
End Sub

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

dhn46 đã viết:
Vâng vậy em chốt lại phương án của em cho câu hỏi lần này:
- Đánh số thự tự theo nhóm, nhóm được tính theo cột TenWB
- Xuất dữ liệu cột SL dạng Number
- Nhóm các hàng có tất cả thông tin trùng nhau (STT,Ten,TenWB,TenSheet) thành 1 số thứ tự và cộng dồn cột SL.

Mã:

Sub STT_Dhn46() Set adoConn = CreateObject("ADODB.Connection") Set adoRS = CreateObject("ADODB.Recordset") With adoConn .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & ThisWorkbook.FullName & _ ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";" .Open End With With adoRS .ActiveConnection = adoConn .Open "Select (Select Count(*)+1 from [sheet1$A1:E35] a Where a.TenWb = [sheet1$A1:E35].TenWb And a.Ten<[sheet1$A1:E35].Ten) As STT, " _ & "Ten, Sum(Val(SL)) as SL, TenWb, TenSheet From [sheet1$A1:E35]" _ & "Group by STT, Ten, TenWb, TenSheet " _ & "Order by TenWb" End With With Sheet2 .[A2:E100].ClearContents .[A2].CopyFromRecordset adoRS End With adoRS.Close: Set adoRS = Nothing adoConn.Close: Set adoConn = Nothing End Sub

Còn phải xử lý lại bạn nhé:
- Nếu có dòng có dữ liệu trùng, code của bạn nó sẽ nhảy STT bị nhảy số tương ứng với dòng trùng thay vì phải bỏ qua những dòng trùng này.
- STT phải được sắp xếp theo thứ tự tăng dần.

Bạn xem kết quả sau khi chạy của bạn nhé.

dhn46 · 19/7/13

Hai Lúa Miền Tây đã viết:
Còn phải xử lý lại bạn nhé:
- Nếu có dòng có dữ liệu trùng, code của bạn nó sẽ nhảy STT bị nhảy số tương ứng với dòng trùng thay vì phải bỏ qua những dòng trùng này.
- STT phải được sắp xếp theo thứ tự tăng dần.

Bạn xem kết quả sau khi chạy của bạn nhé.

Em sửa lại như sau, anh góp ý nhé. Cảm ơn anh HLMT

Mã:

        .Open "Select (Select Count(*)+1 from " _
             & "(Select STT,Ten,TenWb,TenSheet from [sheet1$A1:E50] Tb Group by STT,Ten,TenWb,TenSheet) a " _
             & "Where a.TenWb = [sheet1$A1:E50].TenWb " _
             & "And a.STT&a.Ten&a.TenWb&a.TenSheet < [sheet1$A1:E50].STT&[sheet1$A1:E50].Ten&[sheet1$A1:E50].TenWB&[sheet1$A1:E50].TenSheet) As STT, " _
             & "Ten, Sum(Val(SL)), TenWb, TenSheet From [sheet1$A1:E50]" _
             & "Group by STT, Ten, TenWb, TenSheet " _
             & "Order by TenWb,Ten&TenWb&TenSheet&STT"

quocphuoc88 · 19/8/13

không biết e post câu hỏi trong đây có được không, nhưng sẵn chủ đề này các a và các Thầy cho e hỏi là cái chữ "a" trong câu lệnh SQL này nghĩa là gì ( nếu e hiểu là cột A trong bảng dữ liệu A1:E35 thì đúng không ạ )

.Open "Select (Select Count(*)+1 from [sheet1$A1:E35] a Where a.TenWb = [sheet1$A1:E35].TenWb And a.Ten<[sheet1$A1:E35].Ten) As STT, " _

Cám ơn các a/chị và các Thầy !

dhn46 · 19/8/13

quocphuoc88 đã viết:
không biết e post câu hỏi trong đây có được không, nhưng sẵn chủ đề này các a và các Thầy cho e hỏi là cái chữ "a" trong câu lệnh SQL này nghĩa là gì ( nếu e hiểu là cột A trong bảng dữ liệu A1:E35 thì đúng không ạ )

Mã:

[COLOR=#000000][I].Open "Select (Select Count(*)+1 from [/I][/COLOR][COLOR=#ff0000][I][B][sheet1$A1:E35] a[/B][/I][/COLOR][COLOR=#000000][I] Where a.TenWb = [sheet1$A1:E35].TenWb And a.Ten<[sheet1$A1:E35].Ten) As STT, " _ [/I][/COLOR]

Cám ơn các a/chị và các Thầy !

Bạn hỏi vậy chắc bạn cũng đã tìm hiểu ít nhiều về SQL, a ở đây là cách đặt tên bảng trong truy vấn. Phần màu đỏ đó có thể viết lại như sau cho bạn dễ hình dung, hiểu là cột A trong vùng dữ liệu là sai.

Mã:

[COLOR=#000000][I]........[sheet1$A1:E35]  as a.......

[/I][/COLOR]

quocphuoc88 · 19/8/13

Dạ, e cám ơn a ! E hiểu thêm được chút ít về ADO nữa rồi. E nguyên cứu ADO gần 1 tháng nay mà chả thấy khá hơn chút nào nhưng thấy các a và các Thầy áp dụng nó hay quá nên e cũng cố gắng mày mò. Huy vọng các a và các Thầy tiếp tục bàn luận nữa để e hiểu rõ hơn và vận dụng được ADO ạ !

E cám ơn !

P/s : vậy chữ "a" đó e được thay bằng những chữ khác như "b" được không và chữ "a" này mình cũng không cần phải khai báo ngay từ đầu sub luôn hả a ! ( vì e thấy trong vba thì phải khai báo các biến )

manuchungtinh · 19/8/13

quocphuoc88 đã viết:
P/s : vậy chữ "a" đó e được thay bằng những chữ khác như "b" được không và chữ "a" này mình cũng không cần phải khai báo ngay từ đầu sub luôn hả a ! ( vì e thấy trong vba thì phải khai báo các biến )

Bạn thích thay thành d e f T1...cũng được và cũng không phải khai báo ở đầu thủ tục đâu. Nhưng đặt xong khi gọi tên các trường của vùng đó ra bạn cũng phải thay lun ví dụ :
.Open "Select (Select Count(*)+1 from [sheet1$A1:E35] a Where a.TenWb = [sheet1$A1:E35].TenWb And a.Ten<[sheet1$A1:E35].Ten) As STT, " _
Thành
.Open "Select (Select Count(*)+1 from [sheet1$A1:E35] b Where b.TenWb = b.TenWb And b.Ten < b.Ten) As STT, " _Nó chỉ là cách đặt tên vùng dữ liệu để khi bạn gọi tên cột trong vùng đó viết a.tên cột cho nó gọn ý mà. Không biết mình hỉu vậy đúng hem nhỉ? hi

dhn46 · 19/8/13

manuchungtinh đã viết:
Bạn thích thay thành d e f T1...cũng được và cũng không phải khai báo ở đầu thủ tục đâu. Nhưng đặt xong khi gọi tên các trường của vùng đó ra bạn cũng phải thay lun ví dụ :
.Open "Select (Select Count(*)+1 from [sheet1$A1:E35] a Where a.TenWb = [sheet1$A1:E35].TenWb And a.Ten<[sheet1$A1:E35].Ten) As STT, " _
Thành
.Open "Select (Select Count(*)+1 from [sheet1$A1:E350] b Where b.TenWb = b.TenWb And b.Ten < b.Ten) As STT, " _Nó chỉ là cách đặt tên vùng dữ liệu để khi bạn gọi tên cột trong vùng đó viết a.tên cột cho nó gọn ý mà. Không biết mình hỉu vậy đúng hem nhỉ? hi

- Bạn thử kiểm tra lại phần sửa lại của bạn xem có đúng không nhé. Tại sao lại có phần màu xanh kia? Mình nghĩ bạn nên cân nhắc phần chữ màu đỏ.

- Có lẽ nên để Topic này đúng nghĩa là "Đố vui ADO", những bàn luận tiếp theo chúng ta nên chuyển qua mục ADO căn bản nhỉ?

manuchungtinh · 19/8/13

dhn46 đã viết:
- Bạn thử kiểm tra lại phần sửa lại của bạn xem có đúng không nhé. Tại sao lại có phần màu xanh kia? Mình nghĩ bạn nên cân nhắc phần chữ màu đỏ.

Tất nhiên tùy trường hợp và tùy vào yêu cầu thôi, ý tôi đang muốn giải thích cho người hỏi hiểu thay là thay thế nào ý mà. Tôi cũng đang mơ hồ nên mới hỏi lại là tôi hiểu như thế có đúng không gì mà bạn giãy lên làm tôi giật cả mình, hi, biết thì trả lời giúp tui đi là tôi hiểu thế có đúng hem?

Hai Lúa Miền Tây · 2/11/13

Thay đổi dữ liệu nguồn.

Đã lâu không làm mới Topic này, hôm nay để khởi động lại xin đố 1 câu đố dể về cập nhật dữ liệu:

Mình có 1 cột dữ liệu ở cột A tên cột này là TenVatTu, câu hỏi đặt ra là dựa vào điều kiện cell C2 để cập nhật giá trị cell D2 vào cột TenVatTu.

dhn46 · 2/11/13

Hai Lúa Miền Tây đã viết:
Đã lâu không làm mới Topic này, hôm nay để khởi động lại xin đố 1 câu đố dể về cập nhật dữ liệu:

Mình có 1 cột dữ liệu ở cột A tên cột này là TenVatTu, câu hỏi đặt ra là dựa vào điều kiện cell C2 để cập nhật giá trị cell D2 vào cột TenVatTu.

Em đưa ra phương đầu tiên nhé

Mã:

Sub DHN46()
    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=Yes"";"
        Else
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
        .Open
    End With
    lsSQL = "Update [sheet1$A1:A22] set TenVatTu=""" & [D2] & """ Where TenVatTu=""" & [C2] & """"
    lrs.Open lsSQL, cnn, 3, 1
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
End Sub

Hai Lúa Miền Tây · 2/11/13

dhn46 đã viết:

Em đưa ra phương đầu tiên nhé

Mã:

Sub DHN46()
    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=Yes"";"
        Else
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
        .Open
    End With
    lsSQL = "Update [sheet1$A1:A22] set TenVatTu=""" & [D2] & """ Where TenVatTu=""" & [C2] & """"
    lrs.Open lsSQL, cnn, 3, 1
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
End Sub

Chính xác là như vậy, bẫy ở chổ có dấu nháy đơn. Vậy là bạn đã hiểu mọi vấn đề rồi.

Hai Lúa Miền Tây · 20/1/14

Tôi có 1 file tên là Data như hình sau:

Và 1 file khác tên là Material

Giờ thì làm cách nào ở file Test tôi chạy code sẽ cho kết quả như sau:

Lưu ý là tất cả 3 file được lưu chung vào 1 folder.

dhn46 · 20/1/14

Hai Lúa Miền Tây đã viết:
Tôi có 1 file tên là Data như hình sau:
.......................
Và 1 file khác tên là Material
................
Giờ thì làm cách nào ở file Test tôi chạy code sẽ cho kết quả như sau:
..............
Lưu ý là tất cả 3 file được lưu chung vào 1 folder.

Như thế này có được không anh?

Mã:

Sub ADO()
    Dim cnn As Object, lsSQL As String, lrs As Object, FileFullName As String, StrPath As String
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    FileFullName = Application.ThisWorkbook.FullName
    StrPath = ThisWorkbook.Path
    With cnn
        If Val(Application.Version) < 12 Then
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 8.0;HDR=Yes"";"
        Else
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
        .Open
    End With
    lsSQL = "Select Tb1.MatID,Tb2.[TP],Tb2.[Material Name],Tb2.[Spec],Tb2.[Color],Tb2.[Unit],Tb1.Qty,Tb2.[Origin],Tb2.[Supplier] " _
            & "From [" & StrPath & "\Data.xls].[Data$A1:E65536] Tb1 " _
            & "Left Join  (Select * from [" & StrPath & "\Material.xls].[Material$A1:H65536]) Tb2 " _
            & "On Tb1.MatID=Tb2.MatID " _
            & "Order by Tb2.[MatID]"


    lrs.Open lsSQL, cnn, 3, 1
    Sheet1.[A2:I6000].ClearContents
    Sheet1.Range("A2").CopyFromRecordset lrs
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
End Sub

Hai Lúa Miền Tây · 20/1/14

Nên tận dụng chuổi kết nối với file đích bạn à.

Hai Lúa Miền Tây · 16/5/14

trangk59b đã viết:
& "where f1 like '[NLT]%'"
End With
With Sheet1
.[H2:I65000].ClearContents
.[H2:I2].CopyFromRecordset adoRS
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing
End Sub

Bạn viết cái gì vậy?

hungpecc1 · 7/8/14

Xin chào tất cả các bạn yêu thích, đã và đang sử dụng công cụ ADO.
Hôm nay mình có một câu đố vui thế này :
* Giả sử mình tạo một foder có tên là : YESTERDAY-TODAY;NOW
* Trong folder trên có 1 file excel có gán 1 đoạn code sau :

Mã:

Sub test()
    With [B]CreateObject("ADODB.Connection")[/B]
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & [B]ThisWorkbook.FullName[/B] & _
                                    ";Extended Properties=""Excel 12.0;HDR=No;"";"
        .Open
    End With
    Set cnn = Nothing
End Sub

* Câu hỏi là : Làm sao để sub test() hoạt động được !

Cảm ơn mọi người đã tham gia !

Đố vui về ADO, DAO.

Thành viên gắn bó

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

❆❆❆❆❆❆❆❆

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

File đính kèm

❆❆❆❆❆❆❆❆

File đính kèm

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

File đính kèm

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

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

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

Thành viên chính thức

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

Thành viên chính thức

❆❆❆❆❆❆❆❆

File đính kèm

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

❆❆❆❆❆❆❆❆

❆❆❆❆❆❆❆❆

File đính kèm

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

❆❆❆❆❆❆❆❆

❆❆❆❆❆❆❆❆

Thành viên gắn bó

File đính kèm

Facebook

Group