Question

我正在尝试编写一个宏：

'loop through each row in a 4 column range
'count the blanks
'if there is more than 1 blank anywhere in the row, fill all blanks with "100" 
'if there is 1 or less blanks, leave everything blank

我已经搜索了这些电路板以找到vba代码，这些代码将循环遍历行并从我在这里找到的东西制作了一个复合宏，它可以正常工作，除了不填写每行中的空白，它填充列B和C中的空白（出现在我指定的范围之前）。因为B和C都是完全空白的，所以我只得到100的墙。

以下是代码：

`Sub fillCellsUp()

Dim row As Range
Dim rng As Range
Dim BCount As Long
Dim nextrow As Long
Dim hundred As Integer
hundred = 100
nextrow = ActiveSheet.UsedRange.Rows.Count
Set rng = Worksheets("Worksheet1").Range("D2:G534")
Set row = Range(Cells(nextrow, 4), Cells(nextrow, 7))

For Each row In rng
    On Error Resume Next
    BCount = row.Cells.SpecialCells(xlCellTypeBlanks).Count 
If BCount > 1 Then row.Cells.SpecialCells(xlCellTypeBlanks).Value = hundred
nextrow = nextrow - 1
Next row

End Sub`

我已经包含了我要填写的实际Excel文件的图片：

Answer 1

这是有效的，只需填写你的范围

Private Sub this()

    Dim rng As Range
    Dim rcell As Range

    Set rng = ThisWorkbook.Sheets("Sheet1").Range("d1:g" & ThisWorkbook.Sheets("Sheet1").UsedRange.Rows.Count)

    For Each rcell In rng.Cells
        If rcell.Value = "" Then rcell.Value = "100"
    Next rcell
End Sub

Answer 2

这个怎么样？

Sub fillCellsUp()
Dim lr As Long, i As Long
Dim rng As Range
Dim BCount As Long
Dim hundred As Integer
hundred = 100
lr = ActiveSheet.UsedRange.Rows.Count
For i = 2 To lr
    Set rng = Worksheets("Worksheet1").Range("D" & i & ":G" & i)
    On Error Resume Next
    BCount = rng.SpecialCells(xlCellTypeBlanks).Count
    On Error GoTo 0
    If BCount > 1 Then rng.SpecialCells(xlCellTypeBlanks).Value = hundred
Next i
End Sub

Answer 3

如果您将行替换为底部的 rng ，它看起来会有效：

Dim row As Range
Dim rng As Range
Dim BCount As Long
Dim nextrow As Long
Dim hundred As Integer
hundred = 100
nextrow = ActiveSheet.UsedRange.Rows.Count
Set rng = Worksheets("sheet1").Range("D2:G534")
Set row = Range(Cells(nextrow, 4), Cells(nextrow, 7))

For Each row In rng
    On Error Resume Next
    BCount = row.Cells.SpecialCells(xlCellTypeBlanks).Count
If BCount > 1 Then rng.Cells.SpecialCells(xlCellTypeBlanks).Value = hundred '<this should be rng rather than row
nextrow = nextrow - 1
Next row

End Sub

循环遍历范围中的每一行并填写空白，如果> 1空白

3 个答案: