VBA：跳过处理空白单元格（其中包含公式）

Question

我有一个vba代码，它多次复制一个文件，并在来自表“Linkuire”的列D中的名称列表后重命名输出。
D列充满了将数据导入单元格直到D1000的连接公式。
当连接公式返回“”（如无）时，我希望代码忽略该单元格。

' the range of cells that contain the rename list 
With ActiveWorkbook.Sheets("Linkuire") 
Set rRenameList = .Range("D2", .Cells(.Rows.Count, "D").End(xlUp)) 
End With 

现在只是考虑到即使有些=“”

我怎样才能使代码忽略所有的细胞，其中串连的回报“”所有D2至D1000电池？（我有与转换某片转换成PDF一个VBA代码同样的问题 - 与数据从串连公式得到它把所有的细胞即使串连回报“”和为空）

谢谢。

Answer 1

这应该工作。它会遍历你的范围，只有当长度大于或等于1

Sub Test() 
' Adapted from http://stackoverflow.com/a/8320884/4650297 

    Dim rng1 As Range, rRenameList As Range, cel As Range 
    With ActiveWorkbook.Sheets("Linkuire") 
    Set rng1 = .Range("D2", .Cells(.Rows.Count, "D").End(xlUp)) 
    End With 

    For Each cel In rng1 
    If Len(cel) >= 1 Then 
     If Not rRenameList Is Nothing Then 
      Set rRenameList = Union(rRenameList, cel) 
     Else 
     ' the first valid cell becomes rng2 
      Set rRenameList = cel 
     End If 
    End If 
    Next cel 

Debug.Print rRenameList.Address 
End Sub 

Answer 2

因为纯SpecialCells()方法编辑是行不通的

您添加单元格地址到你的rRenameList可以使用以下两种方法，避免循环：

• AutoFilter()和SpecialCells()方法：

  With ActiveWorkbook.Sheets("Linkuire") 
      With .Range("D1", .Cells(.Rows.count, "D").End(xlUp)) 
       .AutoFilter Field:=1, Criteria1:="<>" '<--| filter out blanks 
       If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then Set rRenameList = .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible) 
      End With 
      .AutoFilterMode = False 
  End With 
  

---

• 配方和这种方法你在一个“助手”列编写公式SpecialCells()方法

  With ActiveWorkbook.Sheets("Linkuire") 
      With .Range("D2", .Cells(.Rows.count, "D").End(xlUp)) 
       .Offset(, 1).FormulaR1C1 = "=IF(RC[-1]="""", 1,"""")" 
       Set rRenameList = .Offset(, 1).SpecialCells(xlCellTypeFormulas, xlNumbers).Offset(, -1) 
       .Offset(, 1).ClearContents 
      End With 
  End With 
  

  我选择是相邻的权利。它可以调整到任何其他偏移量