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

VB Excel忽略范围内的空单元格,excel,vba,Excel,Vba,是否可以告诉范围忽略任何空单元格。例如,我以 Dim v, stMember v = Sheets("Home").Range("B12:B14") For Each stMember In v 由于在B12、B13和B14中有一个值,因此不显示任何错误。但我希望能够将范围扩展到B22,例如,如果该范围内的单元格中没有任何内容,我会收到错误消息。它来自用户输入,因此他们输入的值不会超过10个,但可能输入的值会更少 下面是完整的代码,但它相当长,所以我道歉,如果不是必要的 Sub createS

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

Dim v, stMember
v = Sheets("Home").Range("B12:B14")
For Each stMember In v
由于在
B12、B13和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
简单应该做

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

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

标准方法是测试是否可以将变量设置为该工作表名称(无错误)

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
    比循环好得多
  • 无需
    激活
  • 关闭
    屏幕更新
重现代码

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
Sub Recut()
将ws1设置为工作表
将ws2设置为工作表
变暗rng1 As范围
变暗rng2 As范围
变暗rng3 As范围
暗长
将strSh设置为字符串
strSh=板材(“主”)范围(“B3”)值
出错时继续下一步
设置ws1=图纸(strSh)
错误转到0
如果不是,那么ws1什么都不是
MsgBox“+strSh+”的摘要已存在
出口接头
如果结束
设置ws1=工作表。添加
出错时继续下一步
ws1.Name=strSh
如果错误号为0,则
MsgBox strSh&“是无效名称”
出口接头
如果结束
错误转到0
应用
.ScreenUpdate=False
.EnableEvents=False
以
设置rng1=图纸(“主”)范围(“B12:B14”)
对于rng1中的每个rng2
出错时继续下一步
设置ws2=板材(CStr(rng2.Value2))
错误转到0
如果不是,那么ws2什么都不是
设置rng3=ws2.Range(ws2.[b1],ws2.Cells(Rows.Count,“b”).End(xlUp))
rng3.1自动过滤器,strSh
使用rng3
出错时继续下一步
设置rng4=.Offset(1).调整大小(.Rows.Count-1).特殊单元格(xlCellTypeVisible)
错误转到0
如果不是rng4,那么rng4什么都不是
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
如果结束
以
ws2.AutoFilterMode=False
如果结束
设置ws2=无
下一个
应用
.ScreenUpdate=True
.EnableEvents=True
以
端接头