使用Criteria作为查找VBA填充具有上述值的空单元格

Question

我正在尝试从上面的行复制数据，因为每行都有帐号，但某个帐号在其行中没有其他单元格数据。

更新

来自此原始

的

User    |        Date           |          Location       |      Acct#    |
John    |       11/10/16        |          India          |      1.202027 |
        |                       |                         |      1.202024 |
Anna    |       9/8/16          |           USA           |      1.202027 |
        |                       |                         |      1.202027 |
Isaac   |        9/9/15         |           France        |      1.202024 |
        |        7/9/15         |                         |      1.202027 |

到此：

User    |        Date           |          Location       |      Acct#    |
John    |       11/10/16        |          India          |      1.202027 |
John    |       11/10/16        |          India          |      1.202024 |
Anna    |       9/8/16          |           USA           |      1.202027 |
        |                       |                         |      1.202027 |
Isaac   |        9/9/15         |           France        |      1.202024 |
        |        7/9/15         |                         |      1.202027 |

从上面的示例中我只需要填写“Acct＃”1.202024的数据，其中包含来自acct＃1.202027的数据。如果来自1.202027的细胞是空的，请留下。我不需要填写＃1.202027

的帐号

请注意，它仅填充帐号为1.202024的行下的单元格，其值高于1.202027。如果1.202024的值已经与原始文件中的第二个1.202024一样，那么我们将保留它。如果1.202027账号没有任何价值，即使下方有1.202024，也什么都不做。

这是我要来的代码

 Sub Fillblankcells()
Dim cell As Range, r As Range, s As Range
    For Each r In Range("N2", Cells(rows.Count, "N").End(xlUp))
     For Each s In Range("L2", Cells(rows.Count, "L").End(xlUp))
         If cell.Value Like "*1.202024*" Then
          s = "=R[-1]C"
        End If
    End If
    End If

Next r
End Sub

添加： 只是为了清除范围“N2：N”的值是我的acct编号所在的位置 并且范围“L2：L”只是复制的基础。但我正在尝试从A列复制单元格值：R

我很困惑。谢谢！干杯！

更新！解决

致@ user3598756。我已经使用了

Sub fillblankcells() 'fill columns with criteria
Dim cell As Range
With ActiveSheet
    With .Range("A2", .Cells(.rows.Count, "R").End(xlUp))
   .AutoFilter Field:=14, Criteria1:="1.202024"

 If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then
    For Each cell In .Resize(.rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible)

 If WorksheetFunction.Trim(cell.text) = vbNullString Then cell.Resize(, 13).Value = cell.Offset(-1).Resize(, 13).Value

 Next cell
 End If
 End With
 .AutoFilterMode = False
 End With
 End Sub

Answer 1

你可以尝试这个（评论过的）代码：

Option Explicit

Sub main()
    Dim cell As Range
    With ThisWorkbook.Worksheets("mySheetName") '<--| reference relevant worksheet (change "mySheetName" to your actual sheet name)
        With .Range("K1", .Cells(.Rows.Count, "N").End(xlUp)) '<--| reference ts relevant range: here it's assumed columns K to N from row 1 (header) down to last column "N" not empty cell
            .AutoFilter Field:=4, Criteria1:="1.202024" '<--| filter its 4th column (i.e. column "N") with "1.202024"
            If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any cell filtered other than header
                For Each cell In .Resize(.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible) '<--|loop through filtered cells in 1st column (i.e. column "K")
                    If WorksheetFunction.Trim(cell.Text) = vbNullString Then cell.Resize(, 3).Value = cell.Offset(-1).Resize(, 3).Value '<-- if empty cell then copy from cells above
                Next cell
            End If
        End With
    .AutoFilterMode = False '<--| remove autofilter and brong rows back visible
    End With
End Sub