Question

是否可以告诉范围忽略任何空单元格。例如，我用

启动我的宏

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

由于B12, B13 and B14中有值，因此没有显示任何错误。但我希望能够将范围扩展到B22，但是如果范围内的单元格中没有任何内容，我会收到错误消息。它来自用户输入，因此它们永远不会输入超过10个值，但可能输入更少。

下面是完整的代码，但它很长，所以我很抱歉，如果不是必要的话。

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

为了测试是否存在工作表名称，您应该不仅仅测试空单元格 - 例如工作表可能不存在，单元格中的文本可能包含无效字符等。

标准方法是测试变量是否可以设置 - 没有错误 - 到该工作表名称

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
关闭ScreenUpdating等

重新编码

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

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

2 个答案: