求如何对每一个空白单元格都读入0的程序

gzminge

只是、那个人 发表于 2024-8-9 21:34
定位空格 遍历赋值为0

Set ss = Range("AI2785:BB13540").SpecialCells(xlCellTypeBlanks)

出错了

gzminge

ykcbf1100 发表于 2024-8-9 21:37
用数组的话，最后数组要重新写入工作表，数组写入工作表时是写入数值的，不包括格式。
这次是直接操作单 ...

请老师再帮忙看看这个程序，怎样才能提高效率，我觉得现在运行起有点慢：



Sub 自动粘贴数值()
    Dim r%, i%
    Dim arr, brr
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
   
   
    TS = 0  
   
   
    Dim III As Integer
    For III = 1 To 202
   
   
    With ActiveSheet
        r = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("c3:v" & r).Interior.Color = 16772537
        arr = .Range("c3:v" & r)
        ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
        For i = 1 To UBound(arr) - TS - 1
            d.RemoveAll
            For j = 1 To UBound(arr, 2)
                d(arr(i + TS + 1, j)) = Empty
            Next
            n = 0
            For j = 1 To UBound(arr, 2)
                If d.exists(arr(i, j)) Then
                    .Cells(i + 2, j + 2).Interior.ColorIndex = 3
                    n = n + 1
                    brr(i, n) = j
                End If
            Next
        Next
        .Range("x3").Resize(UBound(brr), UBound(brr, 2)) = brr
    End With
   
   
    Sheets("  0  ").Select
   
   
    Range("Y1:AT25").Select
   
   
  Selection.Copy
  Windows("能定（1）.xlsm").Activate
  Dim searchRange As Range
  Set searchRange = Range("AG2484:AG50000")
  Dim findValue As Variant
  findValue = "999"
  Dim resultCell As Range
  Set resultCell = searchRange.Find(findValue)
  resultCell.Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
  
  
  Windows("（7）.xlsm").Activate
   
   
    Sheets("每天").Activate
    Range("AR1268").Select
    TS = TS + 1
    Selection.Formula = TS
    Next III

End Sub