循环超出第一个循环答案

【问题标题】：loop overrunning first loop循环超出第一个循环
【发布时间】：2019-03-07 16:13:06
【问题描述】：

我的代码一直从下一个单元格运行到下一个列循环，有人可以帮忙吗？主要目的是使用 Input Rng 突出显示整个范围，并在每一列中读取一个红色值，并将寄存器编号返回到输出列的偏移量左侧对于每个单元格的每一列。

ObtainSCEs()
Dim InputRng As Range
Dim OutputRng As Range
Dim Rng As Range

xTitleID = "ObtainSCE"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("select data Range:", xTitleID, InputRng.Address, Type:=8)
Set OutputRng = Application.InputBox("select output Range:", xTitleID, Type:=8)
Dim C As Long
C = 0
Dim B As Long
B = InputRng.Columns.Count
Dim A As Long
A = 1
Dim Cell As Range
Dim Column As Range
    For Each Column In InputRng
        For Each Cell In Column
           If Cell.DisplayFormat.Interior.ColorIndex = 3 Then
               If Len(OutputRng.Offset(0, 0)) > 0 Then
               OutputRng.Offset(0, C).Value = OutputRng.Offset(0, C).Value & ","
               OutputRng.Offset(0, C).Value = OutputRng.Offset(0, C) & Cell.Offset(0, -1 - C).Value
               Else
                OutputRng.Offset(0, C) = Cell.Offset(0, -1 - C).Value
            End If
            End If
        Next Cell

        Next Column


End Sub

我有第二个代码，我尝试使用不同的方法，但它继续运行第一列。如下图所示

  Sub ObtainSCEs()
Dim InputRng As Range
Dim OutputRng As Range
Dim Rng As Range

xTitleID = "ObtainSCE"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("select data Range:", xTitleID, InputRng.Address, Type:=8)
Set OutputRng = Application.InputBox("select output Range:", xTitleID, Type:=8)
Dim C As Long
C = 0
Dim B As Long
B = InputRng.Columns.Count
Dim A As Long
A = 0
Dim Cell As Range
Dim Column As Range

    For n = 1 To 5
    InputRng.Columns(n).Select

        For Each Cell In InputRng.Columns.Cells
           If Cell.DisplayFormat.Interior.ColorIndex = 3 Then
               If Len(OutputRng.Offset(0, 0)) > 0 Then
               OutputRng.Offset(0, C) = OutputRng.Offset(0, C).Value & ","
               OutputRng.Offset(0, C) = OutputRng.Offset(0, C) & Cell.Offset(0, -1 - C).Value
               Else
                OutputRng.Offset(0, C) = Cell.Offset(0, -1 - C).Value
                End If
            End If
        Next Cell
        C = C + 1
    Next n


End Sub

这是我目前用于执行此操作的代码，现在我手动选择所有 6 列，但我想选择 1 个整个范围，然后将该范围拆分为相应的列。

Sub GetSCE()
Application.Volatile True
Dim Rng As Range
Dim InputRng1 As Range, OutputRng As Range
Dim InputRng2 As Range, InputRng3 As Range
Dim InputRng4 As Range, InputRng5 As Range
Dim InputRng6 As Range
Dim Cell As Range
Dim sev1 As Integer
sev1 = 1
Dim sev2 As Integer
sev2 = 2
Dim sev3 As Integer
sev3 = 3
Dim sev4 As Integer
sev4 = 4
Dim sev5 As Integer
sev5 = 5
Dim sev6 As Integer
sev6 = 6
xTitleID = "ObtainSCE"
Set InputRng1 = Application.Selection
Set InputRng1 = Application.InputBox("Select Data Range1:", xTitleID, InputRng1.Address, Type:=8)
Set InputRng2 = Application.InputBox("Select Data Range2:", xTitleID, Type:=8)
Set InputRng3 = Application.InputBox("Select Data Range3:", xTitleID, Type:=8)
Set InputRng4 = Application.InputBox("Select Data Range4:", xTitleID, Type:=8)
Set InputRng5 = Application.InputBox("Select Data Range5:", xTitleID, Type:=8)
Set InputRng6 = Application.InputBox("Select Data Range6:", xTitleID, Type:=8)
Set OutputRng1 = Application.InputBox("Select Starting Cells:", xTitleID, Type:=8)
Set OutputRng2 = Application.InputBox("Select Starting Cells:", xTitleID, Type:=8)
Set OutputRng3 = Application.InputBox("Select Starting Cells:", xTitleID, Type:=8)
Set OutputRng4 = Application.InputBox("Select Starting Cells:", xTitleID, Type:=8)
Set OutputRng5 = Application.InputBox("Select Starting Cells:", xTitleID, Type:=8)
Set OutputRng6 = Application.InputBox("Select Starting Cells:", xTitleID, Type:=8)
    For Each Cell In InputRng1
        If Cell.DisplayFormat.Interior.ColorIndex = 3 Then
            If Len(OutputRng1) > 0 Then OutputRng1.Value = OutputRng1.Value & ","
            OutputRng1.Value = OutputRng1.Value & Cell.Offset(0, -sev1).Value
            Else
        End If
    Next Cell
    For Each Cell In InputRng2
        If Cell.DisplayFormat.Interior.ColorIndex = 3 Then
            If Len(OutputRng2) > 0 Then OutputRng2.Value = OutputRng2.Value & ","
            OutputRng2.Value = OutputRng2.Value & Cell.Offset(0, -sev2).Value
            Else
        End If
    Next Cell
        For Each Cell In InputRng3
        If Cell.DisplayFormat.Interior.ColorIndex = 3 Then
            If Len(OutputRng3) > 0 Then OutputRng3.Value = OutputRng3.Value & ","
            OutputRng3.Value = OutputRng3.Value & Cell.Offset(0, -sev3).Value
            Else
        End If
    Next Cell
        For Each Cell In InputRng4
        If Cell.DisplayFormat.Interior.ColorIndex = 3 Then
            If Len(OutputRng4) > 0 Then OutputRng4.Value = OutputRng4.Value & ","
            OutputRng4.Value = OutputRng4.Value & Cell.Offset(0, -sev4).Value
            Else
        End If
    Next Cell
        For Each Cell In InputRng5
        If Cell.DisplayFormat.Interior.ColorIndex = 3 Then
            If Len(OutputRng5) > 0 Then OutputRng5.Value = OutputRng5.Value & ","
            OutputRng5.Value = OutputRng5.Value & Cell.Offset(0, -sev5).Value
            Else
        End If
    Next Cell
        For Each Cell In InputRng6
        If Cell.DisplayFormat.Interior.ColorIndex = 3 Then
            If Len(OutputRng6) > 0 Then OutputRng6.Value = OutputRng6.Value & ","
            OutputRng6.Value = OutputRng6.Value & Cell.Offset(0, -sev6).Value
            Else
        End If
    Next Cell
End Sub

如果有人需要更清晰的图片，这就是我正在尝试做的事情 Picture of what im trying to do

感谢您的帮助

【问题讨论】：

无法清楚地理解您的目标。但是 C 始终为零，如果找到红细胞，您希望 c 值是多少？
c 应该在每列完成后 +1 到原始值，但我现在无法到达那里，所以我故意将其省略，我将它编辑到第二个代码中，这样你就可以看到它应该在哪里是，哪一部分你不明白，我试着解释得更清楚，
您需要单独遍历每一行还是只需要遍历每个单元格？此外，遍历单元格中的每个单元格是没有意义的...对于 InputRng 中的每个列都不是您要经过的列。有了这个，你就可以遍历 InputRng 中的每个单元格。
我需要遍历所需范围的每一列中的每个单元格，但所需的返回值是第一列中的行标签（我假设您已经看到了图片）。哦，如果我想遍历 InputRng 中的每一列应该是什么？
我在工作中看不到图片，被屏蔽了。

标签： excel vba

【解决方案1】：

可以试试

Sub ObtainSCEs()
Dim InputRng As Range
Dim OutputRng As Range
Dim Rw  As Long
Dim Col As Long

xTitleID = "ObtainSCE"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("select data Range:", xTitleID, InputRng.Address, Type:=8)
Set OutputRng = Application.InputBox("select output Range:", xTitleID, Type:=8)
Dim A As Long
Dim B As Long
Dim C As Long

Dim Cell As Range
Dim Column As Range

    For Col = 1 To InputRng.Columns.Count
        For Rw = 1 To InputRng.Rows.Count
        If InputRng(Rw, Col).Interior.ColorIndex = 3 Then
        Valx = InputRng(Rw, 1).Offset(0, -1).Value
               If Len(OutputRng.Offset(0, Col - 1)) > 0 Then
               OutputRng.Offset(0, Col - 1).Value = OutputRng.Offset(0, Col - 1).Value & "," & Valx
               Else
               OutputRng.Offset(0, Col - 1) = Valx
               End If
        End If
     Next Rw
     Next Col

End Sub

输入范围选择不包括行标签列，用于目标范围的第一个单元格的输出范围选择。

【讨论】：

参考数字都在最左边的同一行，而突出显示的值是每列中的最高数字（它在数据透视表中的数据），我的输出在一行中，会你喜欢我发布我正在使用的当前代码，但使用起来很乏味？它可能会让你更好地理解我想要做什么
编辑后的答案可能会请反馈
它不读取颜色并从 Valx 进入代码并直接跳到 Next rw 即使单元格是红色的。
在条件格式的情况下可以使用 .DisplayFormat 和 OP 一样。同时声明Valx（或直接赋值）并删除未使用的声明
好的，我找到了原因并让它工作，感谢您的帮助，您在 Interior.color 之前缺少显示格式。非常感谢，只是想知道，使用 for 循环而不是 for each 循环更好吗？

【解决方案2】：

这样你可以浏览每一列。

Sub ObtainSCEs()

Dim InRng As Range
Dim OutRng As Range
BoxTitle = "ObtainSCE"
Set InRng = Application.InputBox("Select Data Input Range", BoxTitle, , Type:=8)
Set OutRng = Application.InputBox("Select Data Output Range", BoxTitle, , Type:=8)

Dim cll As Range
Dim col As Range

For Each col In InRng.Columns
    For Each cll In InRng
        If cll.Column = col.Column Then
            '...
            'whatever you want to do
            '...
        End If
    Next cll
Next col


End Sub

【讨论】：

我在 (If cll.Column = Col.Column Then) 行出现错误，它说运行时错误 91，对象变量或块变量未设置。