Question

我有一个Excel范围，包括67列和约4500行。目的是用每行第67列中的硬编码值替换一行中的值，然后标记已替换的值。

因此，我需要检查一行（共66列）中的每个单元格，并查看它们是否满足特定条件，然后在该行的最后用所述硬编码值替换它们。将替换的值标记为粗体时，我的运行时间平均约为360秒。

 Sub searchreplace()

Dim StartTime As Double
Dim Seconds As Double
StartTime = Timer

Dim i As Long
Dim j As Long
Dim arr As Variant
Dim myRange As Range
Dim Rng As String
Dim wb As Workbook
Dim SheetName As String
Dim LessThanEqual As Long

Application.ScreenUpdating = False

Set wb = ThisWorkbook

SheetName = "INPUT_WIND"

Rng = "C3:BQ4466"

LessThanEqual = 1

Set myRange = wb.Worksheets(SheetName).Range(Rng)

arr = myRange.Value

'i = rows = Ubound(arr,1)
'j=columns = Ubound(arr,2)

'loop through rows and clmns

For i = 1 To UBound(arr)

 For j = 1 To myRange.Columns.Count

  If arr(i, j) <= LessThanEqual Then
  arr(i, j) = arr(i, 67)

    myRange.Cells(i, j).Select

    With Selection

    .Font.Bold = True

    End With

  ElseIf IsEmpty(arr(i, j)) = True Then
  arr(i, j) = arr(i, 67)


  End If

  Next j

Next i

myRange.Value = arr

Seconds = Round(Timer - StartTime, 2)

MsgBox "Fertig" & Seconds & "Seconds", vbInformation


Application.ScreenUpdating = True


End Sub

Answer 1

代替此：

import Vue from 'vue';
...
toggleSelect: function () {
    this.someData.forEach(element => {
        Vue.set(element, 'selected', !element.selected);
    });
}

执行此操作：

myRange.Cells(i, j).Select

With Selection
    .Font.Bold = True
End With

速度将提高10倍以上。

更多信息，请参见此处：How to avoid using Select in Excel VBA

Answer 2

这是一个完整的示例，其中详细说明了如何使用Union跟踪哪些单元格有资格接收粗体，然后一次性应用该格式。我的机器大约需要一秒钟才能完成。

Option Explicit

Sub searchreplace()
    Const LessThanEqual As Long = 1

    Dim StartTime  As Double
    Dim i          As Long
    Dim j          As Long
    Dim arr        As Variant
    Dim myRange    As Range
    Dim wb         As Workbook
    Dim UnionRange As Range

    StartTime = Timer
    Application.ScreenUpdating = False
    Set wb = ThisWorkbook
    Set myRange = wb.Worksheets("INPUT_WIND").Range("C3:BQ4466")
    arr = myRange.Value

    For i = LBound(arr, 1) To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            If IsEmpty(arr(i, j)) = False And arr(i, j) <= LessThanEqual Then
                If UnionRange Is Nothing Then
                    Set UnionRange = myRange.Cells(i, j)
                Else
                    Set UnionRange = Union(UnionRange, myRange.Cells(i, j))
                End If
            ElseIf IsEmpty(arr(i, j)) Then
                arr(i, j) = arr(i, 67)
            End If
        Next
    Next

    UnionRange.Font.Bold = True
    myRange.Value = arr
    Debug.Print "This took: " & Round(Timer - StartTime, 2) & " Seconds"
    Application.ScreenUpdating = True
End Sub

有没有办法使此代码运行更快？

2 个答案: