превышение цикла в первом цикле

ProgramBox

превышение цикла в первом цикле

Post author:admin
Запись опубликована:20 мая, 2023
Post category:Вопросы по программированию

#excel #vba

Вопрос:

Мой код продолжает выполняться от следующей ячейки к циклам следующего столбца, кто-нибудь может помочь с этим? основная цель состоит в том, чтобы выделить весь диапазон с помощью входного сигнала 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 amp; ","
               OutputRng.Offset(0, C).Value = OutputRng.Offset(0, C) amp; 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 amp; ","
               OutputRng.Offset(0, C) = OutputRng.Offset(0, C) amp; 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 amp; ","
            OutputRng1.Value = OutputRng1.Value amp; 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 amp; ","
            OutputRng2.Value = OutputRng2.Value amp; 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 amp; ","
            OutputRng3.Value = OutputRng3.Value amp; 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 amp; ","
            OutputRng4.Value = OutputRng4.Value amp; 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 amp; ","
            OutputRng5.Value = OutputRng5.Value amp; 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 amp; ","
            OutputRng6.Value = OutputRng6.Value amp; Cell.Offset(0, -sev6).Value
            Else
        End If
    Next Cell
End Sub

Это то, что я пытаюсь сделать, если кому-то нужна более четкая картина
Изображение того, что я пытаюсь сделать

Спасибо за помощь

1. Не удалось четко понять вашу цель. Однако C всегда равно нулю, каким вы хотите, чтобы значение c было, если найдена красная ячейка?

2. предполагается, что c равен 1 к исходному значению после завершения каждого столбца, но я пока не могу туда добраться, поэтому я намеренно опустил его, я отредактировал его во втором коде, чтобы вы могли видеть, где он должен быть, какую часть вы не могли понять, я попытаюсь объяснить это более четко,

3. Вам нужно просматривать каждую строку по отдельности или вам просто нужно просмотреть каждую ячейку? Кроме того, нет смысла перебирать каждую ячейку в ячейке… Для каждого столбца в InputRng это не тот столбец, который вы просматриваете. С этим для каждого вы просматриваете каждую ячейку в InputRng.

4. мне нужно было бы просмотреть каждую ячейку в каждом столбце нужного диапазона, но желаемое возвращаемое значение — это метка строки в первом столбце (я предполагаю, что вы видели картинку). О, что это должно быть, если я хочу просмотреть каждый столбец во InputRng?

5. Я не могу видеть картинку, так как я на работе, и она заблокирована.

Ответ №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 amp; "," amp; Valx
               Else
               OutputRng.Offset(0, Col - 1) = Valx
               End If
        End If
     Next Rw
     Next Col

End Sub

Выбор входного диапазона исключает столбец меток строк, для выходного диапазона будет достаточно выбора первой ячейки целевого диапазона.

1. Все ссылочные номера находятся в одной строке в крайнем левом углу, в то время как выделенные значения являются наибольшими числами в каждом столбце (его данные в сводной таблице), и мой вывод выводится в одной строке, хотите, чтобы я опубликовал текущий код, который я использую, который работает, но утомителен в использовании? это может дать вам лучшее понимание того, что я пытаюсь сделать

2. Отредактированный ответ может вызвать обратную связь

3. он не считывает цвет и переходит в код из Valx и переходит прямо к следующему rw, даже если ячейка красная.

4. Может использоваться . DisplayFormat как в OP в случае условного форматирования. Также объявляйте Valx (или назначайте напрямую) и удаляйте неиспользуемые объявления

5. Хорошо, я выяснил причину и заставил это работать, спасибо за вашу помощь, вам не хватало формата отображения перед вашим Interior.color. Большое спасибо, просто хочу знать, лучше ли использовать для циклов, а не для каждого цикла?

Ответ №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

1. Я получаю ошибку в (Если cll. Столбец = Кол. Столбец, затем) Строка, в которой говорится об ошибке времени выполнения 91, объектная переменная или блок с неустановленной переменной block.