更改从左到右，从上到下，到上下，从左到右的搜索流程

Question

我希望它从上到下开始搜索第一列，然后是第二个等等。

在“每个”部分我想改变流动

Private Sub CommandButton1_Click() 
    Dim i As Integer 
    Dim j As Integer 

    For j = 2 To 2 
     For i = 21 To 21 

      If Cells(i, j).Value > 0 Then 
       Cells(i, j).Value = Cells(i, j).Value - 1 
       Cells(i, j).Offset(0, -1).Select 
      End If 

      'that is the Matrix I want to Change the search flow in' 
      For Each cell In Range("a2:aap15") 

       If cell.Interior.ColorIndex = 6 Then 
        If cell.Value = "" Then 

         cell.Value = ActiveCell.Value 
         Exit For 

        End If 
       End If 

      Next  
     Next  
    Next 

End Sub 

我必须写这句话，因为stackoverlow不会让我发布，直到它认为我没有做主要的代码了。

新建议（还是同样的问题）：

Private Sub CommandButton1_Click() 
Dim i As Integer 
Dim j As Integer 

'NEW' 
Dim cell As Range, column As Range 

For j = 2 To 2 
For i = 21 To 21 

If Cells(i - 1, j).Value = 0 Then 
If Cells(i, j).Value > 0 Then 
Cells(i, j).Value = Cells(i, j).Value - 1 
Cells(i, j).Offset(0, -1).Select 
End If 
End If 


'NEW' 
For Each column In Range("a2:aap15").Columns 
    For Each cell In column.Cells 


If cell.Interior.ColorIndex = 6 Then 
If cell.Value = "" Then 

cell.Value = ActiveCell.Value 

Exit For 

End If 
End If 

Next 
Next 
Next 
next 

End Sub 

how it shold be

how it is

Answer 1

您可以通过迭代的范围列的单元实现这一目标。

---

Dim cell As Range, column As Range 

For Each column In Range("a2:aap15").Columns 
    For Each cell In column.Cells 

     If cell.Interior.ColorIndex = 6 Then 
      If cell.Value = "" Then 

       cell.Value = ActiveCell.Value 
       Exit For 

      End If 
     End If 
    Next 
Next 

Answer 2

以下依赖于AutoFilter method。 .AutoFilter需要一个不包含在处理中的“标题”行，但行1不能完全空白。

Option Explicit 

Sub firstBlankYellows() 
    Dim c As Long, str As String 

    str = "Task 1" 
    With Worksheets("Sheet4") 
     If .AutoFilterMode Then .AutoFilterMode = False 
     With .Range("A1:AP15") 
      For c = 1 To .Columns.Count 
       With .Columns(c) 
        .AutoFilter field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor 
        With .Resize(.Rows.Count - 1, 1).Offset(1, 0) 
         If Not Intersect(.SpecialCells(xlCellTypeVisible), _ 
             .SpecialCells(xlCellTypeBlanks)) Is Nothing Then 
          Intersect(.SpecialCells(xlCellTypeVisible), _ 
             .SpecialCells(xlCellTypeBlanks))(1) = str 
          Exit For 
         End If 
        End With 
        .AutoFilter 
       End With 
      Next c 
     End With 
     If .AutoFilterMode Then .AutoFilterMode = False 
    End With 
End Sub