如果列中的所有单元格都为空，则不要运行粘贴macros

我有一个macros在列B中查找logging，如果该列中的单元格中有一个值，则该macros将在同一行中的列A中添加一个值。 我的问题发生在列B没有任何值的时候。 macros在这些情况下只是继续无休止的运行。 我正在寻找的是一种说法：

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

我知道这涉及到某种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 

我的search答案从另一个StackOverflow问题产生了这串代码：

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

当我添加到我的代码时，如果列中有任何空白单元格，它只是简单地结束子。

在此先感谢您的帮助！ 如果我的问题太过于荒谬，我很抱歉。

Answer 1

尝试这个：

 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 

Answer 2

这段代码将做你想要的

 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