将非空白单元格复制到下面的单元格中，对每个空白单元格重复答案

【问题标题】：Copy non-blank cell into cell below, repeat for each blank cell将非空白单元格复制到下面的单元格中，对每个空白单元格重复
【发布时间】：2016-04-19 17:41:47
【问题描述】：

我有一个 Excel 数据集，它在 A1 中有一个字符串，在 B1、B2 和 B3 中有与 A1 相关的其他值；依此类推。有时有超过三个单元格与另一个字符串相关（不可预测）。在此示例中，单元格 A2 和 A3 为空白。我想创建一个宏，用 A1 的内容填充 A2 和 A3（等）。

在下面的示例中，我使用 [] 帮助将其格式化为 Excel 单元格。我想从：

[SMITH, John]  [Home]
               [Mobile]
               [Work]
[DOE, John]    [Home]
               [Mobile]

到

[SMITH, John]  [Home]
[SMITH, John]  [Mobile]
[SMITH, John]  [Work]
[DOE, John]    [Home]
[DOE, John]    [Mobile]

我希望宏针对不同的迭代重复此操作，有时我需要手动调整 1000 行。调整输出数据的软件不是一种选择。

我的代码如下：

Sub rname()
Dim cellvar As String
Dim i As Integer

cellvar = ActiveCell
i = 0

While i < 50
If ActiveCell.Offset(1,0) = "" Then
ActiveCell.Offset(1,0) = cellvar
i = i + 1

ElseIf ActiveCell.Offset(1,0) = "*" Then
ActiveCell.Offset(1,0).Activate
i = i + 1

End If
Wend
End Sub

上述代码将文本添加到活动单元格下方的单元格一次，然后停止响应。以下代码运行一次并且不会停止响应 - 我可以再次运行它，但它不会自动向下移动一行。

Sub repeat_name()

Dim cellvar As String
Dim i As Integer

cellvar = ActiveCell
i = 1

For i = 1 To 50

If ActiveCell.Offset(1, 0) = "" Then
    ActiveCell.Offset(1, 0) = cellvar
End If

If ActiveCell.Offset(1, 0) = "*" Then
    ActiveCell.Offset(1, 0).Select.Activate  'I have tried .Offset(2,0)too
End If

i = i + 1
Next

End Sub

我被难住了。有人有什么想法或建议吗？

【问题讨论】：

标签： vba excel

【解决方案1】：

试试看，

Sub fillBlanks()
    With Worksheets("Sheet1")
        With .Range(.Cells(2, "B"), .Cells(Rows.Count, "B").End(xlUp))
            With .Offset(0, -1).SpecialCells(xlCellTypeBlanks)
                .FormulaR1C1 = "=R[-1]C"
            End With
            With .Offset(0, -1)
                .Value = .Value
            End With
        End With
    End With
End Sub

^{fillBlanks 程序之前} ^{fillBlanks 程序之后}

【讨论】：

完美。用不同的方法做我想要的。非常清楚当数据不在下一列时如何调整它。代码很整洁，给了我一些东西来研究以理解它。

【解决方案2】：

其他人给出了可行的解决方案，我将概述您的代码存在的问题。

cellvar = ActiveCell 将活动单元格的值分配给 cellvar 但如果 ActiveCell 更改，则 cellvar 不会更改，因此您只需为所有其他人复制 [SMITH, John]。您必须重新分配 cellvar。

If ActiveCell.Offset(1, 0) = "*" Then 检查单元格是否包含星号。而是使用Not ActiveCell.Offset(1, 0) = ""、ActiveCell.Offset(1, 0) <> ""、Not isEmpty(ActiveCell.Offset(1, 0)) 或仅使用Else（这将是这里的首选版本，因为它不需要进一步计算）。

编辑："*" 可以与Like 运算符一起用作通配符，就像在If ActiveCell.Offset(1, 0) Like "*" Then 中一样，但对于空字符串也是如此。为确保至少有一个标志，您必须改用"?*"。问号代表恰好一个字符，星号代表 0 或更多。要检查单元格是否为空，我会推荐上述方法之一。

在您的第一个 sub 中，这意味着如果单元格不是“*”，则 i 不会增加，并且您会以无限循环结束。在第二个函数中，这意味着活动单元格不会被更改，并且在循环的其余部分不会检测到“”和“*”。

在第二个 sub 中，您不需要 i=i+1，for 循环会为您执行此操作。这意味着您每次迭代都将 i 增加 2。

ActiveCell.Offset(1, 0).Select.Activate这里的“选择”太多了

以下是改动最小的潜艇：

Sub rname()
    Dim cellvar As String
    Dim i As Integer

    cellvar = ActiveCell
    i = 0

    While i < 50
        If ActiveCell.Offset(1, 0) = "" Then
            ActiveCell.Offset(1, 0) = cellvar
            ActiveCell.Offset(1, 0).Activate 'the code will run without this but need to iterations per row
            i = i + 1
            MsgBox "a " & i

        Else
            ActiveCell.Offset(1, 0).Activate
            cellvar = ActiveCell        'reassign cellvar
            i = i + 1
            MsgBox "b " & i
        End If

    Wend
End Sub

第二个子：

Sub repeat_name()

    Dim cellvar As String
    Dim i As Integer

    cellvar = ActiveCell
    'i = 1 'this is not necessary

    For i = 1 To 50

        If ActiveCell.Offset(1, 0) = "" Then
            ActiveCell.Offset(1, 0) = cellvar
        End If

        If Not ActiveCell.Offset(1, 0) = "" Then    'if else endif would be nicer here
            ActiveCell.Offset(1, 0).Activate        'remove "select"
            cellvar = ActiveCell    'reassign cellvar
        End If

        'i = i + 1 'this is not necessary/wrong
    Next i      'safer to include i

End Sub

请注意，这只是为了解释您的代码存在的问题，我仍然建议在此处使用其他解决方案之一。

【讨论】：

您好，非常感谢您花时间解释。我在某处遇到了一个将 * 视为通配符的示例，因此很高兴知道我离题很远（可能浏览得太快了）。我明白你所说的 cellvar 也没有被正确分配是什么意思，这对我来说是一个非常愚蠢的错误。再次感谢您花时间对我进行所有方面的教育；这让我意识到我需要更仔细地考虑每条线路的目标是什么，以及如何实现。
嗨，你对通配符的看法是对的，尽管它显然不能用于= 比较（或 strComp ）。它与Like 运算符一起使用。 “*”仍然是错误的选择（请参阅我编辑的帖子）。

【解决方案3】：

试试这个：

Sub repeat_name()

Dim cellvar As String
Dim i As Integer
Dim ws As Worksheet

Set ws = Sheet1    'Change according to your sheet number
cellvar = ""
For i = 1 To 50

if Trim(ws.Range("A" & i )) <> "" then
 cellvar = Trim(ws.Range("A" & i ))
Else
 ws.Range("A" & i ) = cellvar
End if

Next i

End Sub

【讨论】：

【解决方案4】：

这个怎么样：

Sub FillBlanks()
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
End Sub

【讨论】：

【解决方案5】：

试试这个：

Sub repeat_name()

Dim k As Integer
Dim i As Integer

i = 1
k = ActiveSheet.UsedRange.Rows.Count

While i <= k
    With ActiveSheet
        If .Range("A1").Value = "" Then
            MsgBox "Error: First cell can not be empty."
            Exit Sub
        End If
        If .Range("A" & i).Value = "" And .Range("B" & i).Value <> "" Then
            .Range("A" & i).Value = .Range("A" & i - 1).Value
        End If
    End With
    i = i + 1
Wend

End Sub

【讨论】：

【解决方案6】：

试试这个

Sub test()
lastrow = Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
    If Cells(i, 1) = "" Then
        Cells(i, 1) = Cells(i - 1, 1)
    End If
Next i
End Sub

【讨论】：