如果 Range 包含任何值，VBA 返回 1 - 不工作

Posted 2023-04-13

【中文标题】如果 Range 包含任何值，VBA 返回 1 - 不工作

【英文标题】：VBA To Return 1 if Range contain any value - not working

【发布时间】：2017-06-14 16:35:23

【问题描述】：

这里我遇到问题返回 1010 逻辑测试。它应该检查范围内的每个单元格，如果单元格包含数字，则退出循环。如果范围内的任何单元格包含值，则返回 1，如果所有单元格为空白，则返回 0。我尝试了工作表函数 CountIf、CountA、Not IsEmpty、IsText 但结果不同似乎空白单元格包含不可见的字符串。 IsNumeric 适用于单个单元格，但当包含范围时它不起作用。我还注意到我第一次运行它时会产生结果，第二次运行会导致错误。请帮忙，我的范围需要是可变的。

Sub Try()
Dim path As String, myfile As String, file As String
Dim wb As Workbook
Dim i As Integer
Dim NCell As Range
Dim IsNumber As Boolean

path = "E:\SouthNorth\"
myfile = path & "1979.xls"
file = Dir(myfile)

Set wb = Workbooks.Open(Filename:=path & file)
wb.Activate 'necessary?
i = 24
'here object defined error
For Each NCell In Worksheets("Sheet1").Range(Cells(i, 2), Cells(i, 4)) 
   If IsNumeric(NCell) Then
        IsNumber = True
        If IsNumber = True Then Exit For
    End If
Next NCell
Select Case IsNumber
Case True
wb.Worksheets("Sheet2").Range("B" & i) = 1
Case False
wb.Worksheets("Sheet2").Range("B" & i) = 0
End Select
End Sub

【问题讨论】：

IsNumeric 判断空白单元格为数字。这是你的问题吗？

@SJR，不，IsNumeric 工作正常。我只是想表明所有提到的工作表功能都不起作用。例如。 3 个单元格全部为空白，但 CountA() 返回 3。CountIf(" ") 返回 0，IsText() 返回 True。所以我继续使用 IsNumeric()...

【参考方案1】：

我认为这属于评论，但我不允许...

你提到你的问题是当你尝试运行它 秒 time，这意味着错误可能来自vba试图打开 您的文件已经打开时。其他一切似乎都有效

忽略这一切，这是我最初的“答案”，但我不知道如何格式化罢工，我不想全部删除。

试试这个代码

Sub Try()
    Dim wb As Workbook
    Dim path As String
    Dim i As Integer, j As Integer
    Dim NCell As Range

    path = "E:\SouthNorth\1979.xls"

    Set wb = Workbooks.Open(Filename:=path)
    wb.Activate
    i = 24
    Sheets("Sheet2").Range("B" & i).Value = 0

    For j = 2 To 4
        Set NCell = Sheets("Sheet1").Cells(i, j)
        If IsNumeric(NCell.Value) Then
            Sheets("Sheet2").Range("B" & i).Value = 1
            Exit For
        End If
    Next j

End Sub

【讨论】：

我在第二次运行之前关闭了新打开的 wb，它发生了。另外，我创建新模块并尝试新模块，第一次运行正常（结果错误但至少给出结果），第二次代码因错误而停止。当我在不同的 PC 上工作时，它开始发生。不知道是不是这个原因。

@SitiSal 请查看我添加的代码并告诉我它是否有效

我的意思不是让我听起来很绝望，尽管我有点……你介意将我的答案标记为正确，甚至只是给我一个赞成票吗？我将不胜感激:)

感谢您的回答，并且已经提前投票。很抱歉我的声望在 15 岁以下，这不会改变分数。

哦，我明白了，没关系。谢谢！

【参考方案2】：

您可以使用 'CountBlank' - 如果列范围始终为 3 个单元格，那么您可以声明一个布尔值并从 3 中减去空白计数，如果所有单元格为空白或任何大于 0（真) 如果至少有一个单元格被占用：

Dim x As Boolean
    x = 3 - Application.WorksheetFunction.CountBlank(Worksheets("Sheet1").Range(Cells(i, 2), Cells(i, 4)))
    MsgBox x

如果它特定于数值（例如忽略文本），那么只需添加到您的 IsNumeric 行：

If IsNumeric(ncell) And Not ncell = "" Then

【讨论】：

如何避免布尔值给出应用程序定义/对象定义错误？我试试这个但不起作用； With wb x = 3 - Application.WorksheetFunction.CountBlank(Worksheets("Sheet1").Range(.Cells(i, 2), .Cells(i, 4))) MsgBox x End With

如果您在“With WB”条款中，那么您需要 1) 放置 .在“工作表”前面将该工作表附加到 WB 和 2）删除 .从单元格中并在之后放置 .address （否则编译器认为您正在尝试“workbook.cells(i,2)”......所以尝试：x = 3 - Application.WorksheetFunction.CountBlank(.Worksheets("Sheet1"‌​) .Range(Cells(i, 2).address, .Cells(i, 4).address))

错误 438，对象不支持该属性

我留下了一个 .错误地输入：x = 3 - Application.WorksheetFunction.CountBlank(.Worksheets("Sheet1‌​"‌​).Range(Cells(i, 2).address, .Cells(i, 4).address))

是的，删除一个 .在 Cells() 前面，然后它的工作 x = 3 - Application.WorksheetFunction.CountBlank(.Worksheets("Sheet1‌​‌​"‌​).Range(Cells(i‌​, 2).address, Cells(i, 4) .address))

【参考方案3】：

首先，让定义 Range 对象的 Cells 没有父工作表是一种非常糟糕的做法。请参阅Is the . in .Range necessary when defined by .Cells? 了解更多信息。

Worksheets("Sheet1").Range(Cells(24, 2), Cells(24, 4))

您似乎特别想要数数。引入工作表的 COUNT 函数即可。

With Worksheets("Sheet1")
    With .Range(.Cells(24, 2), .Cells(24, 4))
        Worksheets("Sheet2").Range("B" & i) = Abs(CBool(Application.Count(.Cells)))
    End With
End With

您还可以通过使用 xlCellTypeConstants 和 xlNumbers 的 SpecialCells 严格留在 VBA 中。

Dim rng As Range

With Worksheets("Sheet1")
    On Error Resume Next
    Set rng = .Range(.Cells(24, 2), .Cells(24, 4)).SpecialCells(xlCellTypeConstants, xlNumbers)
    On Error GoTo 0
    If Not rng Is Nothing Then
        Worksheets("Sheet2").Range("B" & i) = 1
    Else
        Worksheets("Sheet2").Range("B" & i) = 0
    End If
End With

【讨论】：

我尝试了 SpecialCells，但结果不同。 SpecialCells(xlCellTypeConstants, xlNumbers) 所有行都返回 1，使用 SpecialCells(xlCellBlanks) 所有行都返回 0。但是谢谢，Abs(CBool​​..) 工作正常。