range1.value = range2.Value非常缓慢的VBA

Question

我正在编写像NextCell.Value = datejour.value一样的简单代码，dateJour是位于工作簿中的单元格中的日期。

当我循环（大约100次）时，它需要永远，因为AddData过程中的每个NextCell.Value = dateJour.value语句需要0.2秒。

.range（NextCell.Offset（0，1），NextCell.Offset（0，8））。值= wssaisie.range（

“由Filldata过程调用，这是循环发生的地方。

它检查了用户填充的数据是否已经存在在称为“Données”的数据表中。如果不是，它将数据添加到表（通过调用AddData），如果是，则修改了数据（通过调用更改）。它逐行进行/逐个检查，因为有时必须添加或修改数据。

非常感谢您的帮助，以改善我的代码！

Public Sub FillData()
    
Dim wsSaisie As Worksheet
    Set wsSaisie = ThisWorkbook.Worksheets("Saisie")
    
    Dim wsData As Worksheet
    Set wsData = ThisWorkbook.Worksheets("Données")
    
    Dim lastRow As Long, lastColumn As Long
    lastRow = wsSaisie.Range("A:H").Find("*" _
        , LookAt:=xlPart _
        , LookIn:=xlFormulas _
        , SearchOrder:=xlByRows _
        , SearchDirection:=xlPrevious).Row
    
    Dim rowKey As String
    Dim foundRowNumber As Long
    
    Dim cell As Range
    For Each cell In wsSaisie.Range(wsSaisie.Range("I5"), wsSaisie.Range("I" & lastRow))
        rowKey = cell.Value
        foundRowNumber = DataAlreadyExists(rowKey)
    
        If foundRowNumber = -1 Then
            Call AddData(cell.Row)
        Else
            Call ChangeData(foundRowNumber, cell.Row)
        End If
    Next cell
End Sub

Public Sub AddData(rowNumber As Long)

    Dim wsSaisie As Worksheet
    Set wsSaisie = ThisWorkbook.Worksheets("Saisie")

    Dim wsData As Worksheet
    Set wsData = ThisWorkbook.Worksheets("Données")

    Dim dateJour As Range
    Set dateJour = wsSaisie.Range("B1")

    Dim nextCell As Range
    Set nextCell = wsData.Range("A1048576").End(xlUp).Offset(1, 0)
    
    'StartTime = Timer
    nextCell.Value = dateJour.Value
    'Debug.Print Round(Timer - StartTime, 2)
    
    wsData.Range(nextCell.Offset(0, 1), nextCell.Offset(0, 8)).Value = wsSaisie.Range("A" & rowNumber, "H" & rowNumber).Value

End Sub

Public Sub ChangeData(rowTo As Long, rowFrom As Long)

    Dim wsSaisie As Worksheet
    Set wsSaisie = ThisWorkbook.Worksheets("Saisie")

    Dim wsData As Worksheet
    Set wsData = ThisWorkbook.Worksheets("Données")
    
    wsData.Range("G" & rowTo & ":" & "I" & rowTo).Value = wsSaisie.Range("F" & rowFrom & ":" & "H" & rowFrom).Value
End Sub

Public Function DataAlreadyExists(key As String) As Long

    Dim wsData As Worksheet
    Set wsData = ThisWorkbook.Worksheets("Données")
    
    If Not IsError(Application.Match(key, wsData.Range("K:K"), 0)) Then
        DataAlreadyExists = Application.Match(key, wsData.Range("K:K"), 0)
    Else
        DataAlreadyExists = -1
    End If
End Function

Answer 1

使用value2代替value（

。

nextCell.Value2 = dateJour.Value2

>

nextCell.Offset(0, 1).Resize(1, 8).Value2 = wsSaisie.Cells(rowNumber, 1).Resize(1, 8).Value2

ref DataAlReadyExists（）函数，您评估匹配两次在存在数据时，例如，请考虑此

Public Function DataAlreadyExists(key As String) As Long

    Dim wsData As Worksheet, resultat as Variant
    Set wsData = ThisWorkbook.Worksheets("Données")
    
    resultat = Application.Match(key, wsData.Range("K:K"), 0)
    If Not IsError(resultat) Then
        DataAlreadyExists = resultat
    Else
        DataAlreadyExists = -1
    End If
End Function