遍历范围内的每一行，并填写空格，如果> 1空白

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

这是怎么回事？

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 2

这部作品，只需填写你范围家伙

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