使用数组的方式,优化以下代码:Sub 一键检查明细数据() On Error Resume Next Application.ScreenUpdating = False Dim ws As Worksheet Set ws = Worksheets("报表1") Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row Dim i As Long For i = 2 To lastRow Dim val As Double, judgeVal As String, v2 As Double, v3 As String val = CDbl(ws.Cells(i, 10).Value) judgeVal = CStr(ws.Cells(i, 11).Value) v2 = CDbl(ws.Cells(i, 12).Value) v3 = CStr(ws.Cells(i, 13).Value) If InStr(judgeVal, "-") > 0 Then Dim item() As String item = Split(judgeVal, "-") Dim firstVal As Double, secondVal As Double firstVal = CDbl(item(0)) secondVal = CDbl(item(1)) Dim item2() As String item2 = Split(v3, "-") Dim S1 As Double, S2 As Double S1 = CDbl(item2(0)) S2 = CDbl(item2(1)) If firstVal > val Or val > secondVal Then ws.Cells(i, 10).Font.Color = 255 ws.Cells(i, 9).Font.Color = 255 ws.Cells(i, 9).Value = ws.Cells(i, 10).Value Else ws.Cells(i, 10).Font.ColorIndex = xlAutomatic ws.Cells(i, 9).Font.ColorIndex = xlAutomatic ws.Cells(i, 9).Value = "" End If If S1 > v2 Or v2 > S2 Then ws.Cells(i, 12).Font.Color = 255 Else ws.Cells(i, 12).Font.ColorIndex = xlAutomatic End If If ws.Cells(i, 12).Value = ws.Cells(i, 13).Value Then ws.Cells(i, 12).Font.ColorIndex = xlAutomatic End If End If Next i ActiveWorkbook.RefreshAll Application.ScreenUpdating = True End Sub
时间: 2024-02-14 11:19:53 浏览: 133
下面是使用数组的优化代码:
Sub 一键检查明细数据()
On Error Resume Next
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = Worksheets("报表1")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim vals() As Double, judgeVals() As String, v2s() As Double, v3s() As String
ReDim vals(2 To lastRow), judgeVals(2 To lastRow), v2s(2 To lastRow), v3s(2 To lastRow)
Dim i As Long
For i = 2 To lastRow
vals(i) = CDbl(ws.Cells(i, 10).Value)
judgeVals(i) = CStr(ws.Cells(i, 11).Value)
v2s(i) = CDbl(ws.Cells(i, 12).Value)
v3s(i) = CStr(ws.Cells(i, 13).Value)
Next i
For i = 2 To lastRow
If InStr(judgeVals(i), "-") > 0 Then
Dim item() As String
item = Split(judgeVals(i), "-")
Dim firstVal As Double, secondVal As Double
firstVal = CDbl(item(0))
secondVal = CDbl(item(1))
Dim item2() As String
item2 = Split(v3s(i), "-")
Dim S1 As Double, S2 As Double
S1 = CDbl(item2(0))
S2 = CDbl(item2(1))
If firstVal > vals(i) Or vals(i) > secondVal Then
ws.Cells(i, 10).Font.Color = 255
ws.Cells(i, 9).Font.Color = 255
ws.Cells(i, 9).Value = ws.Cells(i, 10).Value
Else
ws.Cells(i, 10).Font.ColorIndex = xlAutomatic
ws.Cells(i, 9).Font.ColorIndex = xlAutomatic
ws.Cells(i, 9).Value = ""
End If
If S1 > v2s(i) Or v2s(i) > S2 Then
ws.Cells(i, 12).Font.Color = 255
Else
ws.Cells(i, 12).Font.ColorIndex = xlAutomatic
End If
If ws.Cells(i, 12).Value = ws.Cells(i, 13).Value Then
ws.Cells(i, 12).Font.ColorIndex = xlAutomatic
End If
End If
Next i
ActiveWorkbook.RefreshAll
Application.ScreenUpdating = True
End Sub
主要改动是将每个单元格的数值和字符串值存储到数组中,然后进行操作。这样可以减少对单元格的读写操作,提高代码执行效率。
阅读全文