VB Excel忽略范围内的空单元格

是否有可能告诉一个范围忽略任何空单元格。 例如，我开始我的macros，

Dim v, stMember v = Sheets("Home").Range("B12:B14") For Each stMember In v 

由于在B12, B13 and B14有一个值，所以没有显示错误。 但是，我会看到能够扩大范围为B22例如，但是，如果没有在该范围内的单元格中我收到错误消息。 它从一个用户input，所以他们将永远不会input超过10个值，但可能input较less。

下面是完整的代码，但它的相当长，所以我的道歉，如果不是必要的。

 Sub createSummary() Dim Val As String Val = Sheets("Home").Range("B3").Value If SheetExists(Val) Then MsgBox "Summary for " + Val + " already exists." Else Sheets.Add.Name = Val Sheets(Val).Select ActiveCell.Offset(1, 0).Select Dim v, stMember v = Sheets("Home").Range("B12:B14") For Each stMember In v Dim ws As Worksheet Dim lastrow As Long Set ws = ThisWorkbook.Sheets(stMember) lastrow = ws.Cells(Rows.Count, 2).End(xlUp).Row For i = 2 To lastrow ws.Activate If ws.Range("B" & i).Value = Val Then Range("B" & i).EntireRow.Select Selection.Copy Sheets(Val).Select ActiveCell.Offset(1, 0).Select ActiveCell.End(xlToLeft).Select ActiveCell.PasteSpecial paste:=xlPasteValues Range("J" & ActiveCell.Row).Value = stMember End If Next i Application.CutCopyMode = False Next stMember End If End Sub 

Answer 1

简单的IsEmpty（）应该做的;

 if Not IsEmpty(stMember) then ' do something when not empty ... 

Answer 2

为了testing是否存在图纸名称，您应该超出对空单元格的testing – 例如工作表可能不存在，单元格中的文本可能包含无效字符等。

一个标准的方法是testing一个variables是否可以设置 – 没有错误 – 表名

 Dim ws1 As Worksheet On Error Resume Next Set ws1 = Sheets("sheetname from cell") On Error GoTo 0 If Not ws1 Is Nothing Then 

我已经更新了下面的代码以提高速度

• AutoFilter比循环更好
• 不需要Activate
• closuresScreenUpdating等

recut代码

 Sub Recut() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim rng1 As Range Dim rng2 As Range Dim rng3 As Range Dim lngCnt As Long Dim strSh As String strSh = Sheets("Home").Range("B3").Value On Error Resume Next Set ws1 = Sheets(strSh) On Error GoTo 0 If Not ws1 Is Nothing Then MsgBox "Summary for " + strSh + " already exists." Exit Sub End If Set ws1 = Sheets.Add On Error Resume Next ws1.Name = strSh If Err.Number <> 0 Then MsgBox strSh & " is an invalid name" Exit Sub End If On Error GoTo 0 With Application .ScreenUpdating = False .EnableEvents = False End With Set rng1 = Sheets("Home").Range("B12:B14") For Each rng2 In rng1 On Error Resume Next Set ws2 = Sheets(CStr(rng2.Value2)) On Error GoTo 0 If Not ws2 Is Nothing Then Set rng3 = ws2.Range(ws2.[b1], ws2.Cells(Rows.Count, "b").End(xlUp)) rng3.AutoFilter 1, strSh With rng3 On Error Resume Next Set rng4 = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Not rng4 Is Nothing Then rng4.EntireRow.Copy ws1.Cells(1 + lngCnt, 1) ws1.Cells(lngCnt + 1, "j").Resize(rng4.Cells.Count, 1) = rng2.Value lngCnt = lngCnt + rng4.Rows.Count End If End With ws2.AutoFilterMode = False End If Set ws2 = Nothing Next With Application .ScreenUpdating = True .EnableEvents = True End With End Sub