Em thì em có cách giải quyết khác(nó đơn giản hơn nhiều), nhưng chờ mng giả xem thế nào. Cái của bác em cũng không giám chắc đúng hay ko, nhưng nếu như có thêm chục điều kiện nữa thì iif nó cứ dài loằng ngoằng và khó control lắm ạ.
Em chưa nghe Range trong SQL bao giờ ạ. Mong bác chỉ giáo.
Sub GPE() Dim Query As String
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
With cn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
ThisWorkbook.FullName _
& ";Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
.Open
End With
Query = "SELECT A.f1, Sum(f6 * B.f3) "
Query = Query & "From (Select *, iif(B.f2 >= A.f2,A.f2 - B.f1,B.f2 - B.f1) as f6 From [A2:B6] as A "
Query = Query & "Left Join [D2:F6] as B on A.f2 > B.f1 ) as C Group by A.f1"
rs.Open Query, cn
Range("K2").CopyFromRecordset rs
rs.Close: cn.Close: Set rs = Nothing: Set cn = Nothing
End SubĐúng rùi bạn, bạn có bài nào hay đưa lên để mng cùng thử sức.
Giải thích như thế này:
Bài này có đuợc sử dụng thêm bảng phụ k bạn? Nếu k sử dụng bảng phụ thì truy vấn hơi dài mà yêu cầu report nhiều tháng hơn thì khó mà làm được. Ý bạn là chỉ cần ra như kết ủa mẫu hay muốn tổng quát?
ủa bạn hiểu được đề bài rồi à ? mình nhìn vào chả hiểu gì . hic . Phần Capacity của từng thành viên tính bằng công thức gì vậy ? Ô F3 = 31/12/2030 là ý nghĩa gì ?
Em chưa hiểu điều gì khiến a dị ứng. Còn về vd "bài toán này dùng ADO là hay nhất" thì nó chỉ là ý kiến chủ quan của em. Mục đích em đưa bài này lên chỉ để mng giải trí, thư giãn thui ạ.
Sub GetData()
Dim cn As Object, rs As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Provider = "Microsoft.ACE.OLEDB.12.0"
cn.ConnectionString = "Data Source= " & App.path & "D:\XX.xlsm; Extended Properties=""Excel 12.0;HDR=Yes;"";"
cn.CursorLocation = 3
cn.Open
rs.Open "SELECT * FROM [Sheet1$U23:U23]", cn, 3, 1
Set Text1.DataSource = rs ''Gan len TextBox
cn.Close
End SubEm k dám chắc nhưng em thấy k hợp lý ở chỗ table của a có mỗi cell U23 mà anh lại để HDR là yes, cái thứ 2 nữa là data source ấy, sao lại phải có app.path nhỉ. Đó là ý kiến của em thui nhé
Em thấy dùng ADO thì code nó dễ viết và đơn giản hơn ạ.
ADO là con dao 2 lưỡi, tuỳ theo từng CSDL để làm, nếu xài không khéo thì toi luôn, xài trên excel nên cẩn thận nhiều nhiều
Vâng, em cúng không biết nhiều về ADO, em chỉ thấy bài toán nào áp dụng đc ADO thì em dùng thui ạ.
Mình phải dùng bảng phụ để giải bài của bạn. Không biết ý bạn thế nào.
Tôi có thể viết trong vòng 4 dòng code (190 kí tự, không kể cách trắng) để ra được kết quả
Bạn thử code này
Sub ADOTest()
Dim i As Integer, query As String
Application.ScreenUpdating = False
For i = 4 To 16
query = query + "select f1,f2,'" & Sheets("Nguon").Cells(2, i) & "',f" & i & " from [Nguon$A4:P273]" & Chr(10) & "union all " & Chr(10)
Next
query = Left(query, Len(query) - 11)
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
With cn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
.Open
End With
rs.Open query, cn
Range("F4").CopyFromRecordset rs
rs.Close: cn.Close: Set rs = Nothing: Set cn = Nothing
Application.ScreenUpdating = True
End SubCó thể rút gọn lại code trên thành 8 dòng code. Nhưng vẫn ra kết quả giong nhau.
Bạn có thể cho xem code của bạn ko? để mình còn học tập?
Nằm trong câu đố của anh Hai Lúa đó, đợi người khác giải.
Có thể ít có người quan tâm về câu đố này quá nhỉ
em nghe nói có khai báo
"Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}"
Cái khai báo này có sài được trong office 2016 hay win10 không anh, em sài foxpro kết nối với excel, nhưng bị vướng chỗ này không kết nối được!!!em nghe nói có khai báo
xài được trên 2 phiên bản nhưng mà nó bị hạn chế quá , chắc không phải đáp án của anh nên không trả lời sớm .Mã:"Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}"
mình chỉ biết xài excel thôi nhé bạn , những thứ cao cấp như foxpro (nghe tên là thấy bờ-rồ) mình không biết bạn ơi .
Dim FSO As Object, FileItem As Object, cn As Object, rs As Object, SubFolder As Object
Sub kieumanh(SourceFolderName As String, IncludeSubfolders As Boolean)
Dim query As String
Const ExcelExtension As String = "|xls|xlsb|xlsm|xlsx|"
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
For Each FileItem In .GetFolder(SourceFolderName).Files
If InStr(ExcelExtension, "|" & .GetExtensionName(FileItem.Path) & "|") Then
If Left(FileItem.Name, 1) <> "~" And FileItem.Path <> ThisWorkbook.FullName Then
With cn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileItem.Path & ";Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
.Open
End With
query = " SELECT * FROM [GPE$A2:J200]"
rs.Open query, cn
Range("A" & Range("A65000").End(3).Row + 1).CopyFromRecordset rs
rs.Close: cn.Close
End If
End If
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In .GetFolder(SourceFolderName).SubFolders
kieumanh SubFolder.Path, True
Next SubFolder
End If
End With
Set rs = Nothing: Set cn = Nothing
Set FileItem = Nothing
Set FSO = Nothing
End Sub
Sub run()
Range("A2:J" & Range("A65000").End(3).Row).Clear
Call kieumanh("E:\", True)
Call kieumanh("D:\", True)
End SubHic, fox nó đã bị bỏ rơi lâu rồi, các diễn đàn về fox từ từ cũng mất dần, em lạc hậu nên vẫn còn sài nó, nó vẫn còn hỗ trợ tốt trong một số trường hợp excel không làm được, nên em mới tạo liên kết giữa fox và excel, chắc có lẽ phải hài lòng với win 7 và excel 2013, thanks anh !!!mình chỉ biết xài excel thôi nhé bạn , những thứ cao cấp như foxpro (nghe tên là thấy bờ-rồ) mình không biết bạn ơi .
BẠn cứ mạnh dạn gửi câu trả lời, chủ yếu là học hỏi kinh nghiệm lẫn nhau thôi mà bạn.em nghe nói có khai báo
xài được trên 2 phiên bản nhưng mà nó bị hạn chế quá , chắc không phải đáp án của anh nên không trả lời sớm .Mã:"Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}"
ủa thì chuỗi đặt là
cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & ThisWorkbook.FullNameÝ nói là viết hết cái sub, coi mức độ nó dài đến thế nào ý.
à thì ra ý anh là thi viết code cho ngắn nhất , vậy thì em rớt từ ngoài vòng gửi xe rồi , không có hi vọng , nhưng thôi kệ có nhiêu nhậu nhiêu
Public Sub hello()
Dim cn As Object
Set cn = CreateObject("adodb.connection")
cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & ThisWorkbook.FullName
Sheet1.Range("A1").CopyFromRecordset cn.Execute("select * from [Sheet2$]")
End SubSáng tới giờ mình xuống Sài Gòn chơi ... mới về coi ....thấy không chạy được Vì lấy cả D hay E sao ....Mà trong Hai ổ đó có quá nhiều Folder nó duyệt hoài hay sao .... nếu để y trang vậy chạy là lỗi code
Cái dòng màu đỏ Mạnh thấy chạy hay lỗi trên một số máy lắm và lấy lên nó hay Lỗi Font....Nếu hỏi mình Tại sao ....Tịt
Thật ra em mới chỉ test trên 1 folder (ổ E) với nhiều subfolders thôi. Tại vì anh bảo để trong 50 folder khác nhau mà ko rõ nhưng folder đó có chung đặc điểm gì không nên em phải đọc cả ổ ạ.
Thì cấu trúc Folder nó lộn xộn như bài 240 đó
Mình không đặt nặng vấn đề font, miễn sao lấy được dữ liệu thôi.Cái dòng màu đỏ Mạnh thấy chạy hay lỗi trên một số máy lắm và lấy lên nó hay Lỗi Font....Nếu hỏi mình Tại sao ....Tịt
VD: Font Gốc =Thông ............. Nó Sang Th?ng
Lấy thì OK rồi đó ... nhưng vẫn lỗi code trên 1 số máy ...Office 2007 lỗi chắc luôn
Ý anh ở đây là đã biết trước đường dẫn của các file?
đúng rồi đó ....vấn đề là duyệt file gán vào mãng làm sao cho nó gọn lại và không sử dụng cách mà trên GPE hay xài là Array(file1,file2,... To 50) vậy thôi hay lấy đường dẫn lên Sheet xong duyệt Files
Vậy thì viết như thế nào cho nó chạy với các máy? Xét version là điều không thể tránh?
Hôm thấy code Anh Hải khai báo thấy chạy Tốt ...Nhưng chỉ Office 2007 là Lỗi
Nếu không xét vấn đền font thì tôi viết như sau:
Sub DoVui()
With CreateObject("ADODB.Connection")
.Open "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName
Sheet2.[a2].CopyFromRecordset .Execute("Select * From [Sheet1$]")
End With
End SubNếu xét version thì tôi có thể viết trong vòng 325 kí tự (Không kể dấu cách trắng)
Hay...xúc tích ngắn gọn ...Bạn chỉ cho cách xử lý Font đi
Nếu vậy code ADO cực ngắn...Hóng xem học một tí
Tôi đã thử trên nhiều máy và vẫn ra được kết quả. Không thấy lỗi như bạn.
Vẫn còn nhiều, còn có thể rút gọn được nữa.
Sub ADO_DoVui()
Dim v As String
v = Application.Version
With CreateObject("ADODB.Connection")
.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
Sheet2.[a1].CopyFromRecordset .Execute("Select * From [Sheet1$]")
End With
End SubĐây là câu đố hay là câu hỏi vậy bạn?
Chào bạn,
Cảm ơn bạn đã góp ý. Vấn đề của mình là truy vấn không tối ưu (chạy rất chậm), dữ liệu có 60 dòng thui mà cũng mất khoảng 1s, 100 dòng mất 2.5s.
Mình đã thay đổi truy vấn, tốc độ được cải thiện rất nhiều rùi (100 dòng dữ liệu mất 0.02s, chỉ thay đổi subquery thành table để join thui mà khác hẳn, hic), vậy bạn nào có nhã hứng tham gia giải bài toán này nha.
Xem lại trong code mà bạn khai báo cái đường dẫn, phải thay đổi từ PSNC.xls sang PSNC.xlsm
Public Sub Check_ADOX()
Rem Microsoft ADO Ext. 2.8 for DDL and Security
On Error GoTo Thoat
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:="{00000600-0000-0010-8000-00AA006D2EA4}", Major:=2, Minor:=8
Thoat:
End SubSub LayTenSheet2010()
Dim Dbs As Object, db As Object, tbl As Object
Set Dbs = CreateObject("DAO.DBEngine.36")
Set db = Dbs.OpenDatabase("D:\test.xlsx", False, True, "Excel 12.0;")
For Each tbl In db.TableDefs
If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$'" Then
MsgBox tbl.Name
End If
Next tbl
db.Close
Set Dbs = Nothing: Set db = Nothing: Set tbl = Nothing
End SubPhi thử test là thay màu đỏ thành Excel 8.0 coi nó chạy đc không nhé
Dạ không anh ơi, sửa thành 8.0 thì nó báo lỗi không đúng format
public sub Insert (nhom as string)
............................................
end sub
Insert "A"Insert "B"Insert "C""insert into [Sheet1$B3:B] (f1) " & _
" select '" & nhom & "' & right('000' & (0 & right(max(f1),3)) + 1, 3) " & _
" from [Sheet1$B3:B] where f1 like '" & nhom & "%'"'000' & right(max(f1),3) + 1'000' & [COLOR=#ff0000][SIZE=3][B](0 &[/B][/SIZE][/COLOR] right(max(f1),3)[B][SIZE=3][COLOR=#ff0000])[/COLOR][/SIZE][/B] + 1Nếu insert trên B.xls từ file A.xls đóng thì cú pháp của cấu insert thế naofaf bác?
Thử như sau, bạn test hộ nhé:Chào các bạn trẽ.
Cuối tuần mời các bạn giải trí với bài tập đơn giản như sau:
Tôi có bảng dữ liệu Nhật ký điểm danh các học sinh của 1 lớp. Nhờ các bạn giúp thống kê tính toán xem các học sinh đã nghỉ những ngày nào bằng code ADO, hoặc bất cứ công cụ nào có thể cho ra được kết quả.
Cảm ơn các bạn
Không biết có truờng hợp 4 bạn cùng nghỉ không anh nhỉ?
Ngày đó có thể xem là ngày nghỉ lễ, hoặc dẫn nhau ra quán nhậu hết
