用于跳过某些值并替换为后续限定值的VBA代码

你好

我对编码非常陌生，对用vba宏编码的东西也完全陌生。在excel中发现vba的有用性之后，我现在正努力学习更多关于它的知识。任何帮助或协助都将不胜感激

这是我目前正在使用的代码：

Option Explicit

Const initrow As Integer = 3
Const ENDROW As Long = 65536
Const PrimaryLengthCol As Integer = 1 '"A"

Sub Test()

    Dim lastrow As Double
    Dim i As Double
    Dim irow As Double

    lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    Application.ScreenUpdating = False

    irow = 0
    i = 0
    For i = 0 To lastrow
        If Cells(initrow + irow, PrimaryLengthCol + 2) = "BLANK" Then
            Continue For
            Cells(initrow + i, PrimaryLengthCol + 3).Value = Cells(initrow + irow, PrimaryLengthCol + 2).Value
        End If
    Next

End Sub

所以我遇到的主要问题是：

我在“A”列（输入列）中有以下内容：

• 0
• 14.155
• 14.128
• 15.589
• 空白
• 空白
• 空白
• 15.158

我需要vba代码在每个单元格中循环，如果单元格等于“空白”（文本字符串），则相应的单元格将采用后续的数字。此外，如果列“A”中的值等于零，则输出等于列“B”中的“void”

因此，列“B”（输出列）中的所需输出需要为：

• 空虚
• 14.155
• 14.128
• 15.589
• 15.158
• 15.158
• 15.158
• 15.158

最后一个标准是，如果“A”列中等于“BLANK”的单元格前面有前一个单元格中的零值，则“BLANK”列中的这些单元格也将等于输出列“B”中的“void”值：

因此，如果列“A”有这种情况：

• 0
• 空白
• 空白

输出列“B”需要为：

• 空虚
• 空虚
• 空虚

我不确定如何应用Continue For，因为我希望循环“跳过”下一次迭代的“空白”单元格，但仍然用后续的限定值将相应的值填充到“B”列中。我更愿意通过vba来完成这项工作，因为我再次尝试学习这门语言，所以我强迫自己增加接触它的机会

在此问题上的任何协助都将再次受到高度赞赏

---

谢谢大家!

这里有一个稍微不同的方法，可以使其更易于使用和修改（未经测试）：

---

使用Excel R1C1公式的更高级方法（也未经测试）：

---

.CurrentRegion

获取一个由空单元格包围的矩形区域（类似于单击单元格

A3

并按Ctrl+a），然后

.Offset（，1）

将范围移动到B列，并

调整大小（，1）

可以选择将范围调整为一列，以防B列不为空。

因此，根据Slai的提示，结合我已经使用的代码，我非常欣赏Slai的提示，下面的代码解决了这个问题。我不得不把它分成两个函数来完成我最初的标准。如果有人有一个更有效的方法来完成这个问题，我会非常高兴地了解它

Option Explicit

Const initrow As Integer = 3
Const ENDROW As Long = 65536
Const PrimaryLengthCol As Integer = 1 '"A"

Sub FirstIter()

' initial iteration that exacts value from the adjustment column
    Dim i As Double
    Dim irow As Double

    Worksheets(MatchMLWorksheet).Activate
    irow = 0

    While Not (IsEmpty(Cells(initrow + irow, PrimaryLengthCol + 2)))            ' loop until empty cell
        If Cells(initrow + irow, PrimaryLengthCol + 2).Value = 0 Then
            Cells(initrow + irow, PrimaryLengthCol + 2).Offset(, 1) = "Void"    ' cell.Offset(, 1) is the cell on the right
        ElseIf Cells(initrow + irow, PrimaryLengthCol + 2).Value = "BLANK" Then
            i = irow                           ' sets the count to where cell iteration is
            Do
                i = i + 1                      ' increments the Do Until loop untils
                                               ' it hits the first cell with "BLANK"
            Loop Until Cells(initrow + i, PrimaryLengthCol + 2).Value <> "BLANK" Or Cells(initrow + i, PrimaryLengthCol + 2).Value <> 0

            Cells(initrow + irow, PrimaryLengthCol + 2).Offset(, 1) = Cells(initrow + i, PrimaryLengthCol + 2).Value
                                               ' Overall counter is at the iteration of "blank"
                                               ' resets counter to match overall loop
        Else
            Cells(initrow + irow, PrimaryLengthCol + 2).Offset(, 1) = Cells(initrow + irow, PrimaryLengthCol + 2).Value    ' else just use the same value
        End If

        irow = irow + 1                        ' move to the cell below
    Wend

End Sub

Sub FinalIter()
'Checks entire column to see if it contains any "BLANK"

    Worksheets(MatchMLWorksheet).Activate

    Dim num As Double
    num = 0
    Dim cell As Range
    Dim iMsg As Integer
    Dim b As Double

    Columns("D:D").Select
        Set cell = Selection.Find(What:="BLANK", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    If cell Is Nothing Then
        ' There are no more "BLANK"
        iMsg = MsgBox("There are no more BLANK values!", vbOKOnly)
    Else
        While Not (IsEmpty(Cells(initrow + num, PrimaryLengthCol + 3)))            ' loop until empty cell
            If Cells(initrow + num, PrimaryLengthCol + 3).Value = "BLANK" Then
                b = num                           ' sets the count to where cell iteration is
                Do
                    b = b + 1                      ' increments the Do Until loop untils
                                                   ' it hits the first cell with "BLANK"
                Loop Until Cells(initrow + b, PrimaryLengthCol + 3).Value <> "BLANK"

                Cells(initrow + num, PrimaryLengthCol + 3) = Cells(initrow + b, PrimaryLengthCol + 3).Value
                                               ' Overall counter is at the iteration of "blank"
                                               ' resets counter to match overall loop
            End If

            num = num + 1                        ' move to the cell below
        Wend

    End If

End Sub

选项显式
常量initrow为整数=3
Const ENDROW长度=65536
常量PrimaryLengthCol为整数=1'“A”
次级第一iter（）
'从调整列中提取值的初始迭代
我是双人的
暗淡无光
工作表（匹配工作表）。激活
irow=0
而不是（IsEmpty（Cells（initrow+irow，PrimaryLengthCol+2））循环直到空单元格
如果单元格（initrow+irow，PrimaryLengthCol+2）.Value=0，则
单元格（initrow+irow，PrimaryLengthCol+2）。偏移量（，1）=“Void”单元格。偏移量（，1）是右侧的单元格
ElseIf单元格（initrow+irow，PrimaryLengthCol+2）。Value=“BLANK”然后
i=irow'将计数设置为单元格迭代的位置
做
i=i+1'增加Do直到循环结束
'它在第一个单元格中显示“空白”
循环到单元格（initrow+i，PrimaryLengthCol+2）。值为“空白”或单元格（initrow+i，PrimaryLengthCol+2）。值为0
单元格（initrow+irow，PrimaryLengthCol+2）。偏移量（，1）=单元格（initrow+i，PrimaryLengthCol+2）。值
'总计数器处于“空白”的迭代中'
'重置计数器以匹配整个循环
其他的
单元格（initrow+irow，PrimaryLengthCol+2）。偏移量（，1）=单元格（initrow+irow，PrimaryLengthCol+2）。值“否则只使用相同的值
如果结束
irow=irow+1'移动到下面的单元格
温德
端接头
次终结（）
'检查整个列以查看是否包含任何“空白”
工作表（匹配工作表）。激活
Dim num为双精度
num=0
暗淡单元格作为范围
将iMsg设置为整数
双倍调暗b
列（“D:D”）。选择
Set cell=Selection.Find（What:=“BLANK”，After:=ActiveCell，LookIn:=xlFormulas_
查看：=xlother，搜索顺序：=xlByRows，搜索方向：=xlNext_
MatchCase:=False，SearchFormat:=False）
如果细胞什么都不是
'不再有“空白”
iMsg=MsgBox（“不再有空白值！”，仅限vbOKOnly）
其他的
而不是（IsEmpty（Cells（initrow+num，PrimaryLengthCol+3））循环直到空单元格
如果单元格（initrow+num，PrimaryLengthCol+3）。Value=“BLANK”则
b=num'将计数设置为单元格迭代的位置
做
b=b+1'增加Do直到循环结束
'它在第一个单元格中显示“空白”
循环到单元格（initrow+b，PrimaryLengthCol+3）。值为“空白”
单元格（initrow+num，PrimaryLengthCol+3）=单元格（initrow+b，PrimaryLengthCol+3）。值
'总计数器处于“空白”的迭代中'
'重置计数器以匹配整个循环
如果结束
num=num
Dim colB As Range
Set colB = ThisWorkbook.Worksheets("Sheet1").Range("A3").CurrentRegion.Offset(,1).Resize(,1)

colB.FormulaR1C1 = "=IF(RC[-1]=0, ""Void"", IF(RC[-1]=""BLANK"", R[1]C[-1], RC[-1]))"

colB.Value2 = colB.Value2  ' optional to convert the formulas to values

Option Explicit

Const initrow As Integer = 3
Const ENDROW As Long = 65536
Const PrimaryLengthCol As Integer = 1 '"A"

Sub FirstIter()

' initial iteration that exacts value from the adjustment column
    Dim i As Double
    Dim irow As Double

    Worksheets(MatchMLWorksheet).Activate
    irow = 0

    While Not (IsEmpty(Cells(initrow + irow, PrimaryLengthCol + 2)))            ' loop until empty cell
        If Cells(initrow + irow, PrimaryLengthCol + 2).Value = 0 Then
            Cells(initrow + irow, PrimaryLengthCol + 2).Offset(, 1) = "Void"    ' cell.Offset(, 1) is the cell on the right
        ElseIf Cells(initrow + irow, PrimaryLengthCol + 2).Value = "BLANK" Then
            i = irow                           ' sets the count to where cell iteration is
            Do
                i = i + 1                      ' increments the Do Until loop untils
                                               ' it hits the first cell with "BLANK"
            Loop Until Cells(initrow + i, PrimaryLengthCol + 2).Value <> "BLANK" Or Cells(initrow + i, PrimaryLengthCol + 2).Value <> 0

            Cells(initrow + irow, PrimaryLengthCol + 2).Offset(, 1) = Cells(initrow + i, PrimaryLengthCol + 2).Value
                                               ' Overall counter is at the iteration of "blank"
                                               ' resets counter to match overall loop
        Else
            Cells(initrow + irow, PrimaryLengthCol + 2).Offset(, 1) = Cells(initrow + irow, PrimaryLengthCol + 2).Value    ' else just use the same value
        End If

        irow = irow + 1                        ' move to the cell below
    Wend

End Sub

Sub FinalIter()
'Checks entire column to see if it contains any "BLANK"

    Worksheets(MatchMLWorksheet).Activate

    Dim num As Double
    num = 0
    Dim cell As Range
    Dim iMsg As Integer
    Dim b As Double

    Columns("D:D").Select
        Set cell = Selection.Find(What:="BLANK", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    If cell Is Nothing Then
        ' There are no more "BLANK"
        iMsg = MsgBox("There are no more BLANK values!", vbOKOnly)
    Else
        While Not (IsEmpty(Cells(initrow + num, PrimaryLengthCol + 3)))            ' loop until empty cell
            If Cells(initrow + num, PrimaryLengthCol + 3).Value = "BLANK" Then
                b = num                           ' sets the count to where cell iteration is
                Do
                    b = b + 1                      ' increments the Do Until loop untils
                                                   ' it hits the first cell with "BLANK"
                Loop Until Cells(initrow + b, PrimaryLengthCol + 3).Value <> "BLANK"

                Cells(initrow + num, PrimaryLengthCol + 3) = Cells(initrow + b, PrimaryLengthCol + 3).Value
                                               ' Overall counter is at the iteration of "blank"
                                               ' resets counter to match overall loop
            End If

            num = num + 1                        ' move to the cell below
        Wend

    End If

End Sub