Question

我有两个Excel文件。在第一个文件中，我有485行，在第二个文件中，我有10700行。对于第一个文件中的每一行，我将比较第二个文件中每一行的两个值。

例如，对于第一个文件的第一行，我将其与第二个文件的10700行进行比较，然后对第一个文件的每一行进行比较。

我对第一个文件的前三行进行了测试，这需要五分钟。

如何提高程序速度？

我有一个配备16Go ram的Intel i7-6600U 2.6Ghz。

Sub test()

Dim sht As Worksheet

'Derniere ligne des fichiers
Dim LastRowPosa As Long
Dim LastRowBio As Long

'Cellules des fichiers
Dim rngPosaSejour As Range
Dim rngPosaDate As Range
Dim rngBioSejour As Range
Dim rngBioDate As Range

'item trouvé
Dim itemFound As Boolean

Dim cheminFichier As String

Dim datesEquals As Boolean
Dim sejourEquals As Boolean
Dim isAlbumine As Boolean

Dim tgo As String

'Variables incrémentielles
Dim i As Integer
Dim j As Integer
'Application Excel pour stocker le fichier BIO
Dim XL As Excel.Application
Dim WBK As Excel.Workbook

filePath= "C:\Users\me\Downloads\biologie.xls"

'New xl App
Set XL = CreateObject("Excel.Application")

'Loading the two files
Set WBK = XL.Workbooks.Open(filePath)
Set sht = ActiveSheet

'Get last row of each files
LastRowPosa = sht.Range("A1").CurrentRegion.Rows.Count
LastRowBio = WBK.Sheets("Sheet 1").Range("A1").CurrentRegion.Rows.Count

tgo = "Albumine"

For i = 2 To 3
    Set rngPosaSejour = Application.Range("B" & i)
    Set rngPosaDate = Application.Range("P" & i)

    For j = 2 To LastRowBio
        If WBK.Sheets("Sheet 1").Range("I" & j) = tgo Then    
            Set rngBioSejour = WBK.Sheets("Sheet 1").Range("A" & j)
            Set rngBioDate = WBK.Sheets("Sheet 1").Range("C" & j)
            sejourEquals = rngPosaSejour.Value = rngBioSejour.Value
            datesEquals = Format(rngBioDate, "dd/mm/yyyy") = Format(rngPosaDate, "dd/mm/yyyy")
            isAlbumine = tgo = WBK.Sheets("Sheet 1").Range("C" & j)
            If sejourEquals And datesEquals Then
                sht.Range("I" & i).Value = WBK.Sheets("Sheet 1").Range("j" & j)
            End If    
        End If
    Next j
Next i

End Sub

Answer 1

使用变体数组更快。

Sub test()

Dim sht As Worksheet

'Derniere ligne des fichiers
Dim LastRowPosa As Long
Dim LastRowBio As Long

'Cellules des fichiers
Dim rngPosaSejour As Range
Dim rngPosaDate As Range
Dim rngBioSejour As Range
Dim rngBioDate As Range

'item trouve
Dim itemFound As Boolean

Dim cheminFichier As String

Dim datesEquals As Boolean
Dim sejourEquals As Boolean
Dim isAlbumine As Boolean

Dim tgo As String

'Variables incrementielles
Dim i As Integer
Dim j As Integer
'Application Excel pour stocker le fichier BIO
Dim XL As Excel.Application
Dim WBK As Excel.Workbook


Set sht = ActiveSheet '<~ set sht first

filePath = "C:\Users\me\Downloads\biologie.xls"

'New xl App
Set XL = CreateObject("Excel.Application")

'Loading the two files

Set WBK = XL.Workbooks.Open(filePath)

Dim vDB As Variant, vData As Variant
Dim vR() As Variant

'Get last row of each files
'LastRowPosa = sht.Range("A1").CurrentRegion.Rows.Count
vDB = sht.Range("A1").CurrentRegion
'LastRowBio = WBK.Sheets("Sheet 1").Range("A1").CurrentRegion.Rows.Count
vData = WBK.Sheets("Sheet 1").Range("A1").CurrentRegion
ReDim vR(1 To UBound(vDB, 1), 1 To 1)
tgo = "Albumine"

For i = 2 To UBound(vDB, 1) '3
    'Set rngPosaSejour = Application.Range("B" & i)
    'Set rngPosaDate = Application.Range("P" & i)
    For j = 2 To UBound(vData, 1) 'LastRowBio
        'If WBK.Sheets("Sheet 1").Range("I" & j) = tgo Then
            If vData(j, 9) = tgo Then
            'Set rngBioSejour = WBK.Sheets("Sheet 1").Range("A" & j)
            'Set rngBioDate = WBK.Sheets("Sheet 1").Range("C" & j)
                If vDB(i, 2) = vData(j, 1) And vDB(i, 16) = vData(j, 3) Then
                    'sejourEquals = rngPosaSejour.Value = rngBioSejour.Value
                    'datesEquals = Format(rngBioDate, "dd/mm/yyyy") = Format(rngPosaDate, "dd/mm/yyyy")
                    'isAlbumine = tgo = WBK.Sheets("Sheet 1").Range("C" & j)
                    'If sejourEquals And datesEquals Then
                    '    sht.Range("I" & i).Value = WBK.Sheets("Sheet 1").Range("j" & j)
                    'End If
                    vR(i, 9) = vData(j, 10)
                End If
            End If
        End If
    Next j
Next i
sht.Range("i1").Resize(UBound(vR, 1)) = vR
End Sub

Answer 2

尝试用以下内容替换主循环：

Application.Calculation = xlCalculationManual

For i = 2 To 3
    valPosaSejour = Application.Range("B" & i).Value2
    valPosaDate = Application.Range("P" & i).Value2

    For j = 2 To LastRowBio
        With WBK.Sheets("Sheet 1")
        If .Range("I" & j) = tgo Then
            valBioSejour = .Range("A" & j).Value2
            valBioDate = .Range("C" & j).Value2
            isAlbumine = tgo = .Range("C" & j).Value2
            If (valPosaSejour = valBioSejour) And (valBioDate = rngPosaDate) Then
                sht.Range("I" & i).Value = .Range("j" & j)
            End If
        End If
        End With
    Next j
Next i

Application.Calculation = xlCalculationAutomatic

加载值并进行比较，而不是Set个处理范围（在每种情况下，您只使用一次）就可以了。

将文件的每一行与第二个文件中的数千行进行比较时提高速度

2 个答案: