在特定的表格中填写多列中的空白单元格

我有以下专栏

Score Name Last Name 5460 Name1 Lastname1 2620 340 470 3445 Name2 Lastname2 1290 1170 7460 Name3 Lastname3 3520 360 1500 5048 Name4 Lastname4 830 490 1883 620 1208 185 426 653 

我想填充列B和C中的空单元格，直到列A （在本例中为21行）的最后一行。
结果

 Score Name Last Name 5460 Name1 Lastname1 2620 Name1 Lastname1 340 Name1 Lastname1 470 Name1 Lastname1 3445 Name2 Lastname2 1290 Name2 Lastname2 1170 Name2 Lastname2 7460 Name3 Lastname3 3520 Name3 Lastname3 360 Name3 Lastname3 1500 Name3 Lastname3 5048 Name4 Lastname4 830 Name4 Lastname4 490 Name4 Lastname4 1883 Name4 Lastname4 620 Name4 Lastname4 1208 Name4 Lastname4 185 Name4 Lastname4 426 Name4 Lastname4 653 Name4 Lastname4 

目前我正在尝试适应这个VBA代码：

 Sub FillColBlanksSpecial() Dim wks As Worksheet Dim rng As Range Dim rng2 As Range Dim LastRow As Long Dim col As Long Dim lRows As Long Dim lLimit As Long Dim lCount As Long On Error Resume Next lRows = 2 lLimit = 1000 Set wks = ActiveSheet With wks col = .Range("b1,c1").Column Set rng = .UsedRange 'try to reset the lastcell LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row Set rng = Nothing lCount = .Columns(col).SpecialCells(xlCellTypeBlanks).Areas(1).Cells.Count If lCount = 0 Then MsgBox "No blanks found in selected column" Exit Sub ElseIf lCount = .Columns(col).Cells.Count Then Do While lRows < LastRow Set rng = .Range(.Cells(lRows, col), .Cells(lRows + lLimit, col)) _ .Cells.SpecialCells(xlCellTypeBlanks) rng.FormulaR1C1 = "=R[-1]C" lRows = lRows + lLimit Loop Else Set rng = .Range(.Cells(2, col), .Cells(LastRow, col)) _ .Cells.SpecialCells(xlCellTypeBlanks) rng.FormulaR1C1 = "=R[-1]C" End If End With End Sub 

问题1 ：此代码仅在列B上运行。 如何在列B和C中运行正如你在代码中看到的，我尝试了col = .Range("b1,c1").Column ，但无济于事。

问题2 ：如何在名称以-A和-B只在同一工作簿中结束的工作表中运行此function？

在同一个工作簿中，我有工作表，但是我只想在那些以上述后缀结尾的文件中运行这个工作簿。 谢谢。

Answer 1

您可以使用与循环中的活动工作表相同的variables循环查看工作表集合，检查工作表名称以查看是否需要处理。

 Sub FillColBlanksSpecial() Dim wks As Worksheet For Each wks In Worksheets If Right(wks.Name, 2) = "-A" Or Right(wks.Name, 2) = "-B" Then With wks With .Cells(1, 1).CurrentRegion With .Columns("B:C") If CBool(Application.CountBlank(.Cells)) Then .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]c" End If End With 'un comment the next line if you want the formulas to revert to values only '.Cells = .Cells.Value End With End With End If Next wks End Sub 

我已经添加了一行来将复制的公式恢复到它们的基础值，但留下了评论。 如果您只喜欢数值，请取消注释行。