Question

我有一个Excel数据集，其中包含A1中的字符串，以及B1，B2和B3中与A1相关的其他值;依此类推。有时候有三个以上的单元格与另一个字符串相关（不可预测）。在此示例中，单元格A2和A3是空白的。我想创建一个宏来填充A2和A3（等）的内容为A1。

在下面的示例中，我使用[]帮助将其格式化为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

我在这里难过。有没有人有任何想法或建议？

Answer 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程序之后}

Answer 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=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

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

Answer 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

Answer 4

这个怎么样：

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

Answer 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

Answer 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

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

6 个答案: