求助for循环如何提高速度

cjf1302

表格活动区域为A1:AE2950,其中表格颜色有多个，需要在表格颜色为无色的区域内，输入表格自身的位置

使用FOR循环写了按钮”已经编写“，但是速度非常慢，有什么其他方法可以快速填充无色的区域的内容
详情见附件

kevinchengcw

能少写几句，但速度提升不了多少

ww87725244

判断颜色就必须是cell，数据量大，肯定慢

cjf1302

ww87725244 发表于 2024-9-6 16:05
判断颜色就必须是cell，数据量大，肯定慢

VBA中有没有类似查询功能那样的，选取一个表格后，选用同样格式的表格，填充内容

xjl565135022

1. Private Sub CommandButton2_Click()
   
2.     star_time = Time
   
3.     Application.ScreenUpdating = False '关闭屏幕更新
   
4.     Application.DisplayAlerts = False '关闭提示对话框
   
5.     Set Rng = ActiveSheet.UsedRange
   
6.     arr = ActiveSheet.UsedRange
   
7.     For Each cell In Rng
   
8.         If cell.Interior.ColorIndex = -4142 Then
   
9.             arr(cell.Row, cell.Column) = cell.Row & "行" & cell.Column & "列"
   
10. '            arr(cell.Row, cell.Column) = ""
    
11.         End If
    
12.     Next cell
    
13.     ActiveSheet.UsedRange = arr
    
14.     Application.DisplayAlerts = True '打开提示对话框
    
15.     Application.ScreenUpdating = True '打开屏幕更新
    
16.     stop_time = Time - star_time
    
17.     Debug.Print stop_time
    
18. End Sub

复制代码

原代码用时：2.31481481481888E-05
新代码用时：1.15740740740389E-05
涉及单元格对象的操作都比较耗时，优化后只好了一丢丢

usedrange

1. Private Sub CommandButton1_Click()
   
2.     t = Timer
   
3.     Application.ScreenUpdating = False '关闭屏幕更新
   
4.     Application.DisplayAlerts = False '关闭提示对话框
   
5.     Dim ar, sh, ro%, co%
   
6.     ro = [a1].End(4).Row
   
7.     Set ar = Range("a1:ae" & ro)
   
8.     For Each sh In ar
   
9.         If sh.Interior.ColorIndex = xlNone Then
   
10.             sh.Value = sh.Row & "行" & sh.Column & "列"
    
11.         End If
    
12.     Next sh
    
13.     MsgBox "用时：" & Timer - t
    
14.     Set ar = Nothing
    
15.     Application.DisplayAlerts = True '打开提示对话框
    
16.     Application.ScreenUpdating = True '打开屏幕更新
    
17. End Sub

复制代码

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, i&, j&
   
    With ActiveSheet.UsedRange
        ar = .Value
        For i = 1 To UBound(ar)
            For j = 1 To UBound(ar, 2)
                If .Cells(i, j).Interior.ColorIndex = xlNone Then
                    With .Cells(i, j)
                        ar(i, j) = .Row & "行" & .Column & "列"
                    End With
                End If
            Next j
        Next i
        .Value = ar
    End With
    Beep
End Sub

yes_cn

不知道算不算快，有测试结果通知一下。

renkangjizhen

好像没有捷径可走

tdpzby

把颜色值，单元格值 写入数组，再循环颜色数组，更改数值的数组；最后再把数值写入到单元格