8个表15条记录的数据源。没有Where，生成记录达到上限。

ning84

1. Sub ll1()
   
2. Dim T As Date
   
3.     T = Time
   
4.     Debug.Print T
   
5.     Dim Cn As ADODB.Connection
   
6.     Dim Rs As ADODB.Recordset
   
7.     Dim Sql As String
   
8.     Dim oDate As Date
   
9.     Set Cn = New ADODB.Connection
   
10.     Set Rs = New Recordset
    
11.        oDate = "2023/3/4"
    
12.       
    
13.        Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes';data source=" & ThisWorkbook.FullName
    
14.        'Set Rs = Cn.Execute("Select a.日期,a.日出,b.日出,c.日出,d.日出,e.日出,f.日出,g.日出,h.日出    from [兰州$A5:D2000]a,[珠海$A5:D2000]b,[武汉$A5:D2000]c,[北京$A5:D2000]d ,[抚远$A5:D2000]e,[漠河$A5:D2000]f,[三沙$A5:D2000]g,[喀什$A5:D2000]h   where a.日期 = #2023/3/4#  and  b.日期 = #2023/3/4# and  c.日期 = #2023/3/4# and  d.日期 = #2023/3/4# ")
    
15.       
    
16.        Sql = "Select a.日期,a.日出,b.日出,c.日出,d.日出 "
    
17.        Sql = Sql & ",e.日出,f.日出,g.日出,h.日出   "
    
18.       
    
19.        Sql = Sql & " from [兰州$A5:D20]a,[珠海$A5:D20]b,[武汉$A5:D20]c,[北京$A5:D20]d "
    
20.        Sql = Sql & ",[抚远$A5:D20]e,[漠河$A5:D20]f "
    
21.        Sql = Sql & ",[三沙$A5:D20]g,[喀什$A5:D20]h  "
    
22. Debug.Print Sql
    
23.        Sql = Sql & " where a.日期 = #2022/3/4#  and  b.日期 = #2022/3/4# and  c.日期 = #2022/3/4# and  d.日期 = #2022/3/4# "
    
24.        Sql = Sql & " and e.日期 = #2022/3/4#  and  f.日期 = #2022/3/4# "
    
25.        Sql = Sql & " and  g.日期 = #2022/3/4# and  h.日期 = #2022/3/4# "
    
26. Debug.Print Sql
    
27.        Set Rs = Cn.Execute(Sql)
    
28.        'Rs.MoveFirst
    
29. 
    
30.     Sheet3.Cells.Clear
    
31.     Sheet3.Cells(2, 1).CopyFromRecordset Rs
    
32.     Debug.Print Time
    
33.     Debug.Print T
    
34.     Debug.Print Format(Time - T, "h:mm:ss")
    
35.    
    
36. End Sub
    
37. 
    
38. 
    
39. 
    
40. 
    
41. 
    

复制代码

zxsea_7426

这个需要表达的什么意思，没有看明白？

ning84

1. Function RetuSqlStr(FilePath, oAddress, oDate As Date)
   
2. 
   
3.     Dim Str
   
4.         Str = "Select "
   
5.         Str = Str & "a.日出,a.日落,"
   
6.         Str = Str & "b.日出,b.日落,"
   
7.         Str = Str & "c.日出,c.日落,"
   
8.         Str = Str & "d.日出,d.日落,"
   
9.         Str = Str & "e.日出,e.日落,"
   
10.         Str = Str & "f.日出,f.日落, "
    
11.         Str = Str & "g.日出,g.日落,"
    
12.         Str = Str & "h.日出,h.日落"
    
13.         Str = Str & " From "
    
14.         Str = Str & "[" & FilePath & "].[兰州$" & oAddress & "]a,"
    
15.         Str = Str & "[" & FilePath & "].[珠海$" & oAddress & "]b,"
    
16.         Str = Str & "[" & FilePath & "].[武汉$" & oAddress & "]c,"
    
17.         Str = Str & "[" & FilePath & "].[北京$" & oAddress & "]d,"
    
18.         Str = Str & "[" & FilePath & "].[抚远$" & oAddress & "]e,"
    
19.         Str = Str & "[" & FilePath & "].[漠河$" & oAddress & "]f, "
    
20.         Str = Str & "[" & FilePath & "].[三沙$" & oAddress & "]g, "
    
21.         Str = Str & "[" & FilePath & "].[喀什$" & oAddress & "]h"
    
22.         Str = Str & " Where "
    
23.         Str = Str & "a.日期 = #" & oDate & "# And  "
    
24.         Str = Str & "b.日期 = #" & oDate & "# And  "
    
25.         Str = Str & "c.日期 = #" & oDate & "# And  "
    
26.         Str = Str & "d.日期 = #" & oDate & "# And  "
    
27.         Str = Str & "e.日期 = #" & oDate & "# And  "
    
28.         Str = Str & "f.日期 = #" & oDate & "# And  "
    
29.         Str = Str & "g.日期 = #" & oDate & "# And  "
    
30.         Str = Str & "h.日期 = #" & oDate & "# "
    
31.         ''
    
32.         RetuSqlStr = Str
    
33. 
    
34. End Function
    
35. 
    
36. Private Sub RecordsetSql()
    
37.     Dim Rng As Range
    
38.     Dim Str
    
39.     Dim FilePath, oAddress, oDate As Date
    
40.         FilePath = ThisWorkbook.Path & "\SunriseSunset.xlsx"
    
41.         oAddress = "A5:D996"
    
42.         oDate = "2022/3/3"
    
43.     Dim Cn As ADODB.Connection
    
44.     Dim Rs As ADODB.Recordset
    
45.         Set Cn = New ADODB.Connection
    
46.         Set Rs = New ADODB.Recordset
    
47.         Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes';data source=" & ThisWorkbook.FullName
    
48.         Str = RetuSqlStr(FilePath, oAddress, oDate)
    
49.         Str = Replace(Str, "\Tmp", "")
    
50.         Debug.Print Str
    
51.         Set Rs = Cn.Execute(Str)
    
52.         Debug.Print Sheet3.Name
    
53.         With Sheet3
    
54.              .Cells.Clear
    
55.              .Cells.Font.Size = 9
    
56.              Set Rng = .Cells(2, 2)
    
57.         End With
    
58.         Rng.CopyFromRecordset Rs
    
59.         Rng.Resize(1000, Rs.fields.Count).NumberFormatLocal = "hh:mm;@"
    
60.         Stop
    
61.         Stop
    
62.         Stop
    
63. 
    
64. End Sub

复制代码

ning84

执行这条语句，记录无限增加。都是重复记录。达到最大记录。


       Sql = Sql & " 4from [兰州$A5:D20]a,[珠海$A5:D20]b,[武汉$A5:D20]c,[北京$A5:D20]d "
       Sql = Sql & ",[抚远$A5:D20]e,[漠河$A5:D20]f "
       Sql = Sql & ",[三沙$A5:D20]g,[喀什$A5:D20]h  "

1. 
   
2. Private Sub deldel()
   
3. 
   
4.    Dim Str, iiii As Integer
   
5.    Dim Sht As Worksheet
   
6.    Dim Arr(): Arr = Array("日出", "日落")
   
7.        Str = Space(8) & "Str = " & """Select """ & vbCr
   
8.        iiii = 0
   
9.        For Each Sht In ThisWorkbook.Sheets
   
10.             Str = Str & Space(8) & "Str = str & """ & Chr(97 + iiii) & "." & Arr(0) & "," & Chr(97 + iiii) & "." & Arr(1) & ",""" & vbCr
    
11.             iiii = iiii + 1
    
12.        Next Sht
    
13.        ''Str = Str & Space(8) & "Str = str  & " & """ From """ & vbCr
    
14.        Str = Str & Space(8) & "Str = str  & " & """ From """ & vbCr
    
15.        iiii = 0
    
16.        For Each Sht In ThisWorkbook.Worksheets
    
17.           Str = Str & Space(8) & "Str = str & " & """["" & " & "filepath" & " & ""].[" & Sht.Name & "$" & Chr(34) & " & oAddress " & " & ""]" & Chr(97 + iiii) & "," & vbCr
    
18.           iiii = iiii + 1
    
19.        Next Sht
    
20.        Str = Str & Space(8) & "Str = str  & " & """ Where """ & vbCr
    
21.        iiii = 0
    
22.        For Each Sht In ThisWorkbook.Worksheets
    
23.           Str = Str & Space(8) & "Str = str & """ & Chr(97 + iiii) & ".日期 = #"" & " & "oDate" & " & ""# and """ & vbCr
    
24.           '& ”oDAte" & """#,"" & vbCr"
    
25.           iiii = iiii + 1
    
26.        Next Sht
    
27.        Debug.Print Str
    
28. End Sub
    
29. '''

复制代码

zpy2

建议上传附件，模拟结果

ning84

你没有看到附件吗？好多人已经下载。