For next ,循环上百万条记录，需要多长时间。

ning84

           With Rs
             .MoveFirst
             For ii = 0 To Rs.RecordCount - 1
                ''Debug.Print .Fields(4)
                Set oRng = Sht.Cells(Rr + ii, "J")
                SqlStr = "Select oName,oPath " & SqlShtStr & "Where oName ='" & .Fields(4) & "'"
                Set oRs = SqlRetuRs(SqlStr)
                With oRs
                     .MoveFirst
                     For jj = 0 To .RecordCount - 1
                         oRng(, jj) = .Fields(1)
                         Debug.Print oRng(, jj).Address, Format(Time - T, "h:mm:ss")
                         'oRng.Hyperlinks.Add oRng(, jj), .Fields(1)
                         .MoveNext
                     Next jj
                End With
                .MoveNext
             Next ii
           End With


循环 oRng(, jj) = .Fields(1)，写到单元格中与1秒左右。
循环34710个Rs, 单元格中=34710/60^2,至少在9小时左右。
''''



请问高手运行下面的代码。用了多长时间。几秒钟能完成上百万的记录。
'''

1. 
   
2. Function SqlRetuRs(SqlStr)
   
3. 
   
4.    Dim Cn As ADODB.Connection
   
5.        Set Cn = New ADODB.Connection
   
6.    Dim Rs As ADODB.Recordset
   
7.        Set Rs = New ADODB.Recordset
   
8.         '
   
9.        If InStr(UCase(Application.Path), "WPS") > 0 Then
   
10.            Cn.Open "Provider=Microsoft.JET.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=yes';Data Source=" & ThisWorkbook.FullName
    
11.        Else
    
12.           Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes';data source=" & ThisWorkbook.FullName
    
13.        End If
    
14.        Rs.Open SqlStr, Cn, adOpenKeyset, adLockOptimistic
    
15.        Set SqlRetuRs = Rs
    
16. End Function
    
17. 
    
18. 
    
19. Function GroupYearMonthDay(SqlShtStr, Rng As Range, T As Date)
    
20.     ''"oDate", "Year", "YearMonth", "YearMonthDay", "oName", "oSize", "oType", "oPath"
    
21.     Dim Rs As ADODB.Recordset, oRs As ADODB.Recordset
    
22.     Dim SqlStr
    
23.         SqlStr = "Select  Year, YearMonth, YearMonthDay,oDate, oName, oSize, oType,Count(oName) "
    
24.         'SqlStr = "Select oDate, Year "
    
25.         SqlStr = SqlStr & SqlShtStr
    
26.         SqlStr = SqlStr & " Where Not oName Is Null And oType = 'JPG 文件' "
    
27.         SqlStr = SqlStr & "Group by oDate, Year, YearMonth, YearMonthDay, oName, oSize, oType "
    
28.         
    
29.         'SqlStr = SqlStr & "Group by oDate, Year "
    
30.         SqlStr = SqlStr & " Order By oDate "
    
31.         Debug.Print SqlStr
    
32.    Dim tArr, Str, Rr
    
33.    Dim ii, jj
    
34.        tArr = Array("Year", "YearMonth", "YearMonthDay", "oDate", "oName", "oSize", "oType", "CountName", "oPath")
    
35.        Rng.Resize(, UBound(tArr)) = tArr
    
36.        Set Rs = SqlRetuRs(SqlStr)
    
37.        'Debug.Print Rs.RecordCount, Rng(3, 1).Address
    
38.        Rng(3, 1).CopyFromRecordset Rs
    
39.    Dim Sht As Worksheet, oRng As Range
    
40.        Set Sht = Rng.Parent
    
41.        ''
    
42.        Rr = Rng.Row + 2
    
43.        With Sht
    
44.            .Cells(4, 2) = "=" & Rng.Resize(Rs.RecordCount + 1, Rs.Fields.Count + 1).Address
    
45.            Str = "=""Sql Gropy Date  "" & " & "Count( " & Rng(3, "F").Resize(Rs.RecordCount + 1, 1).Address(0, 0) & ")"
    
46.            .Cells(2, "E") = Str & "&" & " "" ,Time:" & Format(Time - T, "h:mm:ss") & """"
    
47.       
    
48.            With Rs
    
49.              .MoveFirst
    
50.              For ii = 0 To Rs.RecordCount - 1
    
51.                 ''Debug.Print .Fields(4)
    
52.                 Set oRng = Sht.Cells(Rr + ii, "J")
    
53.                 SqlStr = "Select oName,oPath " & SqlShtStr & "Where oName ='" & .Fields(4) & "'"
    
54.                 Set oRs = SqlRetuRs(SqlStr)
    
55.                 With oRs
    
56.                      .MoveFirst
    
57.                      For jj = 0 To .RecordCount - 1
    
58.                          oRng(, jj) = .Fields(1)
    
59.                          Debug.Print oRng(, jj).Address
    
60.                          'oRng.Hyperlinks.Add oRng(, jj), .Fields(1)
    
61.                          .MoveNext
    
62.                      Next jj
    
63.                 End With
    
64.                 .MoveNext
    
65.              Next ii
    
66.            End With
    
67.            Str = "=""Sql Gropy Date  "" & " & "Count( " & Rng(4, "F").Resize(Rs.RecordCount + 1, 1).Address(0, 0) & ")"
    
68.            .Cells(3, "E") = Str & "&" & " "" ,Time:" & Format(Time - T, "h:mm:ss") & """"
    
69.        End With
    
70.       
    
71.        Stop
    
72.       
    
73.        Stop
    
74. End Function
    
75. 
    
76. Sub del()
    
77.    Dim Tt As Date: Tt = Time
    
78.    Dim Rng As Range
    
79.    Dim FolderRng As Range
    
80.    Dim AllFileRng As Range
    
81.    Dim Str
    
82.    Dim Rr, Cc
    
83.        Rr = 10
    
84.        Cc = 20
    
85.    Dim SqlShtStr
    
86.        With Sheet3
    
87.            SqlShtStr = " From [" & .Name & "$" & .Range(.Cells(4, 1).Formula).Address(0, 0) & "] "
    
88.            Debug.Print SqlShtStr
    
89.            GroupYearMonthDay " From [" & .Name & "$" & .Range(.Cells(4, 1).Formula).Address(0, 0) & "] ", .Cells(Rr, 1), Tt
    
90.        End With
    
91.        Stop
    
92. 
    
93. End Sub
    

复制代码

ning84

With Rs
             .MoveFirst
             For ii = 0 To Rs.RecordCount - 1
                ''Debug.Print .Fields(4)
                Set oRng = Sht.Cells(Rr + ii, "J")
                SqlStr = "Select oName,oPath " & SqlShtStr & "Where oName ='" & .Fields(4) & "'"
                Set oRs = SqlRetuRs(SqlStr)
                With oRs
                     .MoveFirst
                     For jj = 0 To .RecordCount - 1
                         oRng(, jj) = .Fields(1)
                         Debug.Print oRng(, jj).Address, Format(Time - T, "h:mm:ss")
                         'oRng.Hyperlinks.Add oRng(, jj), .Fields(1)
                         .MoveNext
                     Next jj
                End With
                .MoveNext
             Next ii
           End With
**************************************************

$I$2735       0:44:48
$I$2736       0:44:49
$I$2737       0:44:50
$I$2738       0:44:51
$I$2739       0:44:52
$I$2740       0:44:53
$I$2741       0:44:54
$I$2742       0:44:55
$I$2743       0:44:56
$I$2744       0:44:57
$I$2745       0:44:58
$I$2746       0:44:59
$I$2747       0:45:00
$I$2748       0:45:01
$I$2749       0:45:02
$I$2750       0:45:03
$I$2751       0:45:05
*****************************
for next 2751单元格


运行45分钟。

kevinchengcw

range操作太多了，不如说目的，别人重新帮你写写看

ning84

kevinchengcw 发表于 2024-7-2 14:15
range操作太多了，不如说目的，别人重新帮你写写看

谢谢回复。同意你的太多Range操作的表述。
循环34710，For   oRng(, jj) = .Fields(1)  Next 方法肯定有问题。

1. Function GroupYearMonthDay(SqlShtStr, Rng As Range, T As Date, RootName)
   
2.     ''"oDate", "Year", "YearMonth", "YearMonthDay", "oName", "oSize", "oType", "oPath"
   
3.     Dim Rs As ADODB.Recordset, oRs As ADODB.Recordset
   
4.     Dim SqlStr
   
5.         SqlStr = "Select  Year, YearMonth, YearMonthDay,oDate, oName, oSize, oType,Count(oName),"
   
6.         SqlStr = SqlStr & "'" & RootName & "\' + Format(oDate, 'yyyy年') + '\' + Format(oDate, 'yyyy年mm月') + '\' + Format(oDate, 'yyyy年mm月dd日') + '\' + oName ,"
   
7.         SqlStr = SqlStr & " IIf(COUNT(oName) > 0, MAX(IIf(oPath LIKE '%\%\%', oPath, NULL)), NULL), "
   
8.         SqlStr = SqlStr & " IIf(COUNT(oName) > 1, MAX(IIf(oPath LIKE 'F:\JPG\StreetSnap\%\%\%\%', oPath, NULL)), NULL) "
   
9.         'SqlStr = "Select oDate, Year "
   
10.         SqlStr = SqlStr & SqlShtStr
    
11.         SqlStr = SqlStr & " Where Not oName Is Null And oType = 'JPG 文件' "
    
12.         SqlStr = SqlStr & "Group by oDate, Year, YearMonth, YearMonthDay, oName, oSize, oType "
    
13.         
    
14.         'SqlStr = SqlStr & 6"Group by oDate, Year "
    
15.         SqlStr = SqlStr & " Order By oDate "
    
16.         Debug.Print SqlStr
    
17.    Dim tArr, Str, Rr
    
18.    Dim ii, jj
    
19.        tArr = Array("Year", "YearMonth", "YearMonthDay", "oDate", "oName", "oSize", "oType", "CountName", "oPath")
    
20.        Rng.Resize(, UBound(tArr)) = tArr
    
21.        Set Rs = SqlRetuRs(SqlStr)
    
22.        'Debug.Print Rs.RecordCount, Rng(3, 1).Address
    
23.        Rng(3, 1).CopyFromRecordset Rs
    
24.    Dim Sht As Worksheet, oRng As Range
    
25.        Set Sht = Rng.Parent
    
26.        ''
    
27.        Rr = Rng.Row + 2
    
28.        With Sht
    
29.            .Cells(4, 2) = "=" & Rng.Resize(Rs.RecordCount + 1, Rs.Fields.Count + 1).Address
    
30.            Str = "=""Sql Gropy Date  "" & " & "Count( " & Rng(3, "F").Resize(Rs.RecordCount + 1, 1).Address(0, 0) & ")"
    
31.            .Cells(2, "E") = Str & "&" & " "" ,Time:" & Format(Time - T, "h:mm:ss") & """"
    
32.        End With
    
33.        Stop
    
34.        Stop
    
35.        Stop
    
36. End Function
    

复制代码

kevinchengcw

这个试一下，结果写到AC10开始的位置

1. Sub test()
   
2. Dim Dic, Arr, Arrt, Arrk, N&, I&, R&, S$, OK As Boolean, T#
   
3. T = Timer
   
4. Set Dic = CreateObject("scripting.dictionary")
   
5. With ThisWorkbook.Worksheets("TraverseFolderAndFile11")
   
6.   Arrt = Split("Year,YearMonth,YearMonthDay,oDate,oName,oSize,oType,CountName,oPath", ",")
   
7.   Arrk = Arrt: R = 1
   
8.   Arr = .Range("t10:t" & .Cells(.Rows.Count, "t").End(3).Row).Resize(, UBound(Arrt) + 1).Value
   
9.   For N = LBound(Arrk) To UBound(Arrk)
   
10.     For I = LBound(Arr, 2) To UBound(Arr, 2)
    
11.       If Arr(1, I) = Arrk(N) Then Arrk(N) = I: Exit For
    
12.     Next I
    
13.   Next N
    
14.   Arrk(7) = ""
    
15.   For I = LBound(Arr, 2) To UBound(Arr, 2)
    
16.     Arr(1, I) = Arrt(I - 1)
    
17.   Next I
    
18.   For N = LBound(Arr) + 1 To UBound(Arr)
    
19.     If Arr(N, 5) <> "" Then
    
20.       If Arr(N, 7) = "JPG 文件" Then
    
21.         S = ""
    
22.         For I = LBound(Arr, 2) To LBound(Arr, 2) + 6
    
23.           S = S & vbTab & Arr(N, I)
    
24.         Next I
    
25.         If Dic.exists(S) Then
    
26.           Arr(Dic(S), 8) = Arr(Dic(S), 8) + 1
    
27.         Else
    
28.           R = R + 1: Dic(S) = R
    
29.           If R = N Then
    
30.             For I = LBound(Arrk) To UBound(Arrk)
    
31.               If Arrk(I) = "" Then Arrt(I + 1) = 1 Else Arrt(I + 1) = Arr(N, Arrk(I))
    
32.             Next I
    
33.             For I = LBound(Arrt) To UBound(Arrt)
    
34.               Arr(R, I + 1) = Arrt(I)
    
35.             Next I
    
36.           Else
    
37.             For I = LBound(Arrk) To UBound(Arrk)
    
38.               If Arrk(I) = "" Then Arr(R, I + 1) = 1 Else Arr(R, I + 1) = Arr(N, Arrk(I))
    
39.             Next I
    
40.           End If
    
41.         End If
    
42.       End If
    
43.     End If
    
44.   Next N
    
45.   .[ac10].Resize(R, UBound(Arr, 2)).Value = Arr
    
46. End With
    
47. Set Dic = Nothing
    
48. Debug.Print Timer - T
    
49. End Sub

复制代码

ning84

kevinchengcw 发表于 2024-7-3 09:30
这个试一下，结果写到AC10开始的位置

非常感谢你的帮助For  rang next一个一个效率特别低。

遍历数组，效率很高。使用数组灵活方便。

1.   For N = LBound(Arr) + 1 To UBound(Arr)
   
2.     If Arr(N, 5) <> "" Then
   
3.       If Arr(N, 7) = "JPG 文件" Then
   
4.         S = ""
   
5.         For I = LBound(Arr, 2) To LBound(Arr, 2) + 6
   
6.           S = S & vbTab & Arr(N, I)
   
7.         Next I
   
8.         If Dic.Exists(S) Then
   
9.           Stop
   
10.           Arr(Dic(S), 8) = Arr(Dic(S), 8) + 1
    
11.          
    
12.         Else
    
13.           R = R + 1: Dic(S) = R
    
14.           If R = N Then
    
15.             For I = LBound(Arrk) To UBound(Arrk)
    
16.               If Arrk(I) = "" Then Arrt(I + 1) = 1 Else Arrt(I + 1) = Arr(N, Arrk(I))
    
17.             Next I
    
18.             For I = LBound(Arrt) To UBound(Arrt)
    
19.               Arr(R, I + 1) = Arrt(I)
    
20.             Next I
    
21.           Else
    
22.             For I = LBound(Arrk) To UBound(Arrk)
    
23.               If Arrk(I) = "" Then Arr(R, I + 1) = 1 Else Arr(R, I + 1) = Arr(N, Arrk(I))
    
24.             Next I
    
25.           End If
    
26.         End If
    
27.       End If
    
28.     End If
    
29.   Next N

复制代码

学习dictonary统计重复数。