Question

我有一个链接到外部来源的模板。

我的前任创造了它，而且为了“容易”而创造了它。在眼睛上，他/她通过跳过一排来创造它。即第1行然后第3行，第5行，第9行，第13行等具有公式，而在这些提到的行之间只是默认空格。

我创建了一个打开工作簿并复制我想要的工作表的vba。

如果我使用下面的代码，它的运行速度非常慢，并且出于某种原因，它会循环多次。

for each cell in usedrange
if cell.hasformula = true and instr(cell.formula, "SUMIF") > 0 then
      cell.formulaR1C1 = "='\\tel\folder1\folder2\[xlsheet.xlsx]SheetName'!RC
   end if
next cell

因此，我所做的是实际分配一次，复制它然后粘贴到相应的单元格（如下所示）。

Workbooks(desWB).Sheets(maxSheet + 1).Range("J5").FormulaR1C1 = fullPath
Workbooks(desWB).Sheets(maxSheet + 1).Range("J5").Copy
Workbooks(desWB).Sheets(maxSheet + 1).Range("J6:J12,E48:J55,E57:J58,E61:J79,E84:J93,E96:J96,E99:J103").PasteSpecial Paste:=xlPasteFormulas

后一种方法有效，它肯定比第一种方法快得多。但是，现在我面临的情况是，由于模板的设置，有些行有公式而有些行没有，并且它会进入数千行。有时跳过行也不是2的增量，它可能是3,5等。

所以我想知道是否有更有效率的方式：

查看使用的范围
如果范围有公式且公式有＆＃39; SUMIF＆＃39;
将公式更改为其他内容
Else SKIP并检查下一个单元格

Answer 1

如果您只想处理该行中第一个单元格具有非空单元格值的行，那么您应该迭代Range行和列并跳过行第一个单元格未通过测试。

您使用For Each cell in range方法的当前代码仍会将处理单元格保留为空行 - 这是多余的。

您可以使用以下代码跳过空白行，并仅将条件逻辑应用于您确信某些单元格具有您要更新的公式的行。在示例中，我使用Range("C4:E10")，但您可以替换适用于您的Range，具体取决于您的工作簿结构。

Option Explicit

Sub Test()
    'could pass in UsedRange of the sheet...
    IterateRange ThisWorkbook.Worksheets("Sheet1").Range("C4:E10")
End Sub

Sub IterateRange(rng As Range)

    Dim rngCell As Range
    Dim intX As Integer
    Dim intY As Integer

    'iterate all cells in range
    For intX = 1 To rng.Rows.Count
        For intY = 1 To rng.Columns.Count
            'get a cell
            Set rngCell = rng.Cells(intX, intY)
            'check if cell is blank or empty
            If IsEmpty(rngCell.Value) Or rngCell.Value = "" Then
                'skip the rest of the columns in this row and goto next row
                Exit For
            Else
                'this row has non-empty cells - do something
                Debug.Print rngCell.Address
                'some other test
                If rngCell.HasFormula And InStr(1, rngCell.Formula, "SUMIF") Then
                    'update formula...
                    Debug.Print rngCell.Formula
                End If
            End If
        Next intY
    Next intX

End Sub

Answer 2

要执行的代码行：

Range("A1:A10").SpecialCells(xlCellTypeVisible).Value = "1"

'此行向A1：A10范围内的可见单元发送1

Excel VBA - 粘贴到可见单元格

2 个答案: