如果列中的所有单元格都为空,请不要运行粘贴宏

时间:2017-08-02 12:04:33

标签: excel vba excel-vba

我有一个宏在列B中查找记录,如果该列中的单元格中有值,则宏将在同一行中向列A添加值。当B列中没有任何值时,我的问题就出现了。在这些情况下,宏只会继续无休止地运行。我正在寻找的是一种说法:

  • 如果B列包含NO值,则跳到下一个宏。

我知道这涉及到某种IF语句,我无法弄清楚如何将这种逻辑添加到我现有的代码中。

我的代码:

Sub Update_Column_Based_On_Column_Value_1()
On Error Resume Next
    Dim ws As Worksheet
    Dim lRow As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row
        .Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=If(LEN(RC2),""NEW VALUE GOES HERE"", TEXT(,))"
        .Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value
    End With
End Sub

我对答案的搜索产生了另一个StackOverflow question的代码串:

If WorksheetFunction.CountBlank(emailRng) = emailRng.Cells.Count Then Exit Sub  'No data

当我将其添加到我的代码中时,如果列中有任何空白单元格,则只会结束sub。

提前感谢您的帮助!如果我的问题过于苛刻,我会道歉。

2 个答案:

答案 0 :(得分:0)

试试这个:

Sub Update_Column_Based_On_Column_Value_1()
On Error Resume Next
    Dim ws As Worksheet
    Dim lRow As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' This will count all non-blanks in Column B, I put equal to 1
    ' because I am assuming B1 is a header with a title so it will at minimum be 1
    If WorksheetFunction.CountA(ws.Range("B:B")) = 1 Then
        ' if count is equal to 1 then this part will run
        ' so enter name of the sub() or write new code in here
    Else
        ' if not less than or equal, meaning greater than 1
        ' then the following code below will run
        With ws
            lRow = .Range("B" & .Rows.Count).End(xlUp).Row
            .Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=If(LEN(RC2),""NEW VALUE GOES HERE"", TEXT(,))"
            .Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value
        End With
    End If

答案 1 :(得分:0)

此代码将执行您想要的操作

Sub test()
Dim i As Long
Dim lRow As Long

lRow = Cells(Rows.Count, "B").End(xlUp).Row

    For i = 2 To lRow
        If Cells(i, "B").Value <> vbNullString Then
            Cells(i, "A").Value = Cells(i, "B").Value
        End If
    Next i

End Sub