将非空白单元格复制到下面的单元格中，为每个空白单元格重复
我有一个Excel数据集，其中包含A1中的string，以及B1，B2和B3中与A1相关的其他值; 依此类推。 有时有三个以上的单元格与另一个string相关（不可预测的）。 在这个例子中，单元格A2和A3是空白的。 我想要创build一个macros来填充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]
我想要macros重复这个不同的迭代，有时我有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
我被困在这里。 有没有人有任何想法或build议？
试试看，
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程序 之后
其他人已经给出了工作解决scheme，我只是概述了你的代码的问题。
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但是这也适用于空string。 为确保至less有一个符号，您必须使用"?*"代替。 问号代表正好一个字符，星号代表0或更多。 要检查一个单元格是否为空，我会推荐上述方法之一。
在你的第一个子集中，这意味着如果单元格中除“*”之外的任何东西，我都不会增加，并且以无限循环结束。 在第二个函数中，这意味着活动单元格将不会被更改，并且循环的其余部分都不会被检测到。
在第二个子节中，你不需要i=i+1 ， for循环为你做。 这意味着你每增加一次，我就会增加2。
ActiveCell.Offset(1, 0).Select.Activate这里的“select”太多了
这里是最小变化的潜艇：
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
请注意，这只是为了解释你的代码的问题，我仍然build议在这里使用其他解决scheme之一。
尝试这个：
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
这个怎么样：
Sub FillBlanks() Columns("A:A").Select Selection.SpecialCells(xlCellTypeBlanks).Select Selection.FormulaR1C1 = "=R[-1]C" End Sub
尝试这个：
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
尝试这个
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