Excel VBA-粘贴到可见单元格

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等。

因此，我想知道是否存在一种更有效，更有效的方法：

• 看一下使用范围
• 如果范围具有公式AND公式具有'SUMIF'
• 将公式更改为其他内容
• 否则跳过并检查下一个单元格

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