遍歷範圍內的每一行，並填寫空格，如果> 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