vba VB Excel忽略范围内的空单元格
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/25408010/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VB Excel ignore empty cells in range
提问by Tim Wilkinson
Is it possible to tell a range to ignore any empty cells. For example I start my macro with,
是否可以告诉范围忽略任何空单元格。例如我开始我的宏，
Dim v, stMember
v = Sheets("Home").Range("B12:B14")
For Each stMember In v
As there is a value in B12, B13 and B14there shows no errors. But i would look to be able to expand the range to B22for example, however if there is nothing in a cell in the range i get error messages. Its from a user input so they will never enter more than 10 values, but could possibly enter less.
因为那里有一个值，B12, B13 and B14所以没有显示错误。但是我希望能够将范围扩展到B22例如，但是如果范围内的单元格中没有任何内容，我会收到错误消息。它来自用户输入，因此他们永远不会输入超过 10 个值，但可能输入更少。
Below is the full code but its quite long so my apologies if not neccessary.
下面是完整的代码，但它很长，所以如果没有必要，我很抱歉。
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
采纳答案by Tim Wilkinson
回答by brettdj
For testing if the sheet names exists you should go beyond testing for empty cells - for example sheet may not exist, the text in the cell may contain invalid characters etc.
为了测试工作表名称是否存在，您应该超越测试空单元格 - 例如工作表可能不存在，单元格中的文本可能包含无效字符等。
A standard approach is to test whether a variable can be set - without an error - to that sheet name
标准方法是测试是否可以将变量设置为该工作表名称（没有错误）
Dim ws1 As Worksheet
On Error Resume Next
Set ws1 = Sheets("sheetname from cell")
On Error GoTo 0
If Not ws1 Is Nothing Then
I have updated the code in full below to improve the speed
我已经在下面完整更新了代码以提高速度
AutoFiltermuch better than looping- No need for
Activate - Turn
ScreenUpdatingoff etc
AutoFilter比循环好得多- 不需要
Activate - 开启
ScreenUpdating关闭等
recut code
重新编码
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
