Посещая наш сайт, вы соглашаетесь с нашей политикой конфиденциальности в отношении файлов cookie, статистики отслеживания и т. д.

Главная » Вопросы и ответы

Проблема в Excel VBA: код зацикливается, но пропускает последнюю строку цикла

На чтение 8 мин Опубликовано
Содержание
  1. Вопрос или проблема
  2. Ответ или решение
  3. Проблема
  4. Возможные улучшения
  5. Заключение

Вопрос или проблема

В настоящее время я использую VBA для проверки, совпадает ли содержимое столбца E (например, строка X) с содержимым в столбце B (например, строка Y). Предположим, значение X:E равно ‘a’, тогда программа будет искать, существует ли ‘a’ в любых строках столбца B. Допустим, есть 4 строки, в которых значение ‘a’. В зависимости от другого условия, она найдет строку Y среди этих 4 строк. Допустим, 3-я строка – это моя требуемая строка Y. Но код выдает в результате 2-ю строку, то есть строку, которая непосредственно предшествует требуемой. Как это исправить?

Ожидаемый результат: ‘a’ столбца E в строке X совпадает с ‘a’ столбца B в строке Y. Ниже приведен код:

Sub CaseOneTwoandFour()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim componentNames As New Collection
    Dim cell As Range
    Dim item As Variant
    Dim foundRow As Variant
    Dim i As Long
    Dim j As Long
    Dim cellValue As Variant
    Dim matchRow As Long
    Dim matchFound As Boolean
    Dim tempValue As Variant
    Dim initialRowColor As Long

    ' Установите рабочий лист
    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' Найдите последнюю строку
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' Цикл по каждой ячейке в столбце A и добавление уникальных имен компонентов в коллекцию
    On Error Resume Next
    For Each cell In ws.Range("A5:A" & lastRow)
        If cell.Value <> "" Then
            componentNames.Add cell.Value, CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0

    For Each item In componentNames
        ' Найдите строку с указанным именем компонента в столбце A
        foundRow = Application.Match(item, ws.Range("A5:A" & lastRow), 0)
        If IsError(foundRow) Then Exit Sub

        ' Цикл по строкам ниже найденной строки с именем компонента
        For i = 5 To lastRow
            cellValue = ws.Cells(i, 3).Value

            ' Проверьте, содержат ли столбцы D и E или столбцы F и G содержимое
            If (Len(Trim(ws.Cells(i, 4).Value)) > 0 And Len(Trim(ws.Cells(i, 5).Value)) > 0) Or _
               (Len(Trim(ws.Cells(i, 6).Value)) > 0 And Len(Trim(ws.Cells(i, 7).Value)) > 0) Then

                matchFound = False

                ' Проверьте, совпадают ли содержимое из столбца E (5) или G (7) с любой ячейкой в столбце B (2)
                For j = 5 To ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
                    If StrComp(ws.Cells(j, 2).Value, ws.Cells(i, 5).Value, vbBinaryCompare) = 0 Or _
                       StrComp(ws.Cells(j, 2).Value, ws.Cells(i, 7).Value, vbBinaryCompare) = 0 Then

                        If Not ws.Rows(j).Find(What:=cellValue, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
                            matchRow = j
                            matchFound = True
                            Exit For
                        End If
                    End If
                Next j

                If matchFound Then
                    ' Убедитесь, что matchRow установлен перед его использованием
                    If matchRow > 0 Then
                        If Len(Trim(ws.Cells(matchRow, 5).Value)) > 0 Then
                            tempValue = ws.Cells(matchRow, 5).Value
                        ElseIf Len(Trim(ws.Cells(matchRow, 7).Value)) > 0 Then
                            tempValue = ws.Cells(matchRow, 7).Value
                        End If

                        initialRowColor = ws.Cells(i, 8).Interior.Color
                        If StrComp(ws.Cells(i, 2).Value, tempValue, vbBinaryCompare) = 0 Then
                            ws.Cells(i, 8).Interior.Color = RGB(0, 255, 0) ' Зеленый цвет для начальной строки
                            ws.Cells(matchRow, 8).Interior.Color = RGB(0, 255, 0) ' Зеленый цвет для совпадающей строки
                        Else
                            ws.Cells(i, 8).Interior.Color = RGB(255, 0, 0) ' Красный цвет
                            ws.Cells(i, 9).Value = "Неправильное соединение"
                        End If
                    End If
                Else
                    ws.Cells(i, 8).Interior.Color = RGB(255, 0, 0) ' Красный цвет
                    ws.Cells(i, 9).Value = "Неправильное соединение"
                End If
            End If

            ' Подсветка красным, если E или G имеют содержимое, но D или F соответственно не имеют
            If (Len(Trim(ws.Cells(i, 5).Value)) > 0 And Len(Trim(ws.Cells(i, 4).Value)) = 0) Or _
               (Len(Trim(ws.Cells(i, 7).Value)) > 0 And Len(Trim(ws.Cells(i, 6).Value)) = 0) Then
                ws.Cells(i, 8).Interior.Color = IIf(StrComp(item, "connector", vbBinaryCompare) = 0, RGB(255, 255, 0), RGB(255, 0, 0))
                If ws.Cells(i, 1).Value = "connector" Then ws.Cells(i, 8).Interior.Color = RGB(255, 255, 0)
                ws.Cells(i, 9).Value = "Одно из соединений отсутствует для соединителя"
            End If

            ' Подсветка красным, если все столбцы D, E, F и G пусты
            If Len(Trim(ws.Cells(i, 4).Value)) = 0 And Len(Trim(ws.Cells(i, 5).Value)) = 0 And _
               Len(Trim(ws.Cells(i, 6).Value)) = 0 And Len(Trim(ws.Cells(i, 7).Value)) = 0 Then
                ws.Cells(i, 8).Interior.Color = RGB(255, 255, 0) ' Красный цвет
                ws.Cells(i, 9).Value = "Существует взаимодействие с не терминальным компонентом (Нет Производителя или Потребителя)"
            End If

            ' Если все столбцы D, E, F и G содержат информацию, выделите красным
            If Len(Trim(ws.Cells(i, 4).Value)) > 0 And Len(Trim(ws.Cells(i, 5).Value)) > 0 And _
               Len(Trim(ws.Cells(i, 6).Value)) > 0 And Len(Trim(ws.Cells(i, 7).Value)) > 0 Then
                ws.Cells(i, 8).Interior.Color = RGB(255, 0, 0) ' Красный цвет
            End If

        Next i
    Next item
End Sub

Ответ или решение

Конечно! Давайте рассмотрим вашу проблему и посмотрим, как можно исправить код, чтобы он не пропускал последнюю строку в цикле, что может быть причиной неверного результата.

Проблема

Ваша текущая реализация использует два вложенных цикла для поиска совпадений. Однако, поскольку вы начинаете перебор с строки 5 (т.е. For i = 5 To lastRow), вам нужно убедиться, что все строки обрабатываются правильно и что последняя строка не пропускается.

Ваша логика описывает, как нужно искать совпадения между колонкой E и колонкой B, и сама по себе эта логика выглядит правильной. Основная проблема может заключаться в том, как вы ищете совпадения и как определяются значения matchRow.

Возможные улучшения

  1. Убедитесь, что вы правильно обновляете переменные matchRow и matchFound внутри вашего внутреннего цикла. Возможно, стоит использовать дополнительные условия, чтобы гарантировать, что вы всегда получаете последнее найденное значение.

  2. Избегайте использования Exit Sub, если вы хотите продолжать искать совпадения после того, как нашли первое.

  3. Убедитесь, что диапазоны обработки корректные и что вы не используете Rows.Count, которые могут выдавать не те результаты в случае, если в вашей колонке есть пропуски.

Вот переработанная версия вашего кода с соответствующими исправлениями:

Sub CaseOneTwoandFour()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim componentNames As New Collection
    Dim cell As Range
    Dim item As Variant
    Dim foundRow As Variant
    Dim i As Long
    Dim j As Long
    Dim cellValue As Variant
    Dim matchRow As Long
    Dim matchFound As Boolean
    Dim tempValue As Variant
    Dim initialRowColor As Long

    ' Устанавливаем рабочий лист
    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' Находим последнюю строку
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' Цикл по диапазону A и добавляем уникальные названия компонентов в коллекцию
    On Error Resume Next
    For Each cell In ws.Range("A5:A" & lastRow)
        If cell.Value <> "" Then
            componentNames.Add cell.Value, CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0

    For Each item In componentNames
        ' Находим строку с указанным названием компонента в колонке A
        foundRow = Application.Match(item, ws.Range("A5:A" & lastRow), 0)
        If IsError(foundRow) Then Exit Sub

        ' Цикл по строкам ниже найденной строки
        For i = 5 To lastRow
            cellValue = ws.Cells(i, 3).Value
            matchFound = False
            matchRow = 0

            If (Len(Trim(ws.Cells(i, 4).Value)) > 0 And Len(Trim(ws.Cells(i, 5).Value)) > 0) Or _
               (Len(Trim(ws.Cells(i, 6).Value)) > 0 And Len(Trim(ws.Cells(i, 7).Value)) > 0) Then

                ' Проверка на совпадение в колонке B
                For j = 5 To lastRow
                    If StrComp(ws.Cells(j, 2).Value, ws.Cells(i, 5).Value, vbBinaryCompare) = 0 Or _
                       StrComp(ws.Cells(j, 2).Value, ws.Cells(i, 7).Value, vbBinaryCompare) = 0 Then

                        If Not ws.Rows(j).Find(What:=cellValue, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
                            matchRow = j
                            matchFound = True
                        End If
                    End If
                Next j

                If matchFound Then
                    If matchRow > 0 Then
                        If Len(Trim(ws.Cells(matchRow, 5).Value)) > 0 Then
                            tempValue = ws.Cells(matchRow, 5).Value
                        ElseIf Len(Trim(ws.Cells(matchRow, 7).Value)) > 0 Then
                            tempValue = ws.Cells(matchRow, 7).Value
                        End If

                        ' Проверка совпадения
                        If StrComp(ws.Cells(i, 2).Value, tempValue, vbBinaryCompare) = 0 Then
                            ws.Cells(i, 8).Interior.Color = RGB(0, 255, 0) ' Зеленый цвет для начальной строки
                            ws.Cells(matchRow, 8).Interior.Color = RGB(0, 255, 0) ' Зеленый цвет для совпадающей строки
                        Else
                            ws.Cells(i, 8).Interior.Color = RGB(255, 0, 0) ' Красный цвет
                            ws.Cells(i, 9).Value = "Неверное соединение"
                        End If
                    End If
                Else
                    ws.Cells(i, 8).Interior.Color = RGB(255, 0, 0) ' Красный цвет
                    ws.Cells(i, 9).Value = "Неверное соединение"
                End If
            End If

            ' Дополнительные условия для раскрашивания строк...
        Next i
    Next item
End Sub

Заключение

Попробуйте применить этот улучшенный код и проверьте, работает ли он так, как вы ожидаете. Правильно настроенные циклы и условия должны устранить проблему пропуска последней строки в вашей логике.

Если проблема сохранится, проведите отладку с использованием точки останова на различных этапах обработки, чтобы увидеть значения переменных и убедиться, что код действительно проходит через весь необходимый диапазон.

debugging error-handling excel vba
Оцените материал
Добавить комментарий

Капча загружается...

© 2024 IZ6.RU
*В материалах сайта упоминаются социальные сети Фейсбук / Инстаграм, принадлежащие Meta Platforms Inc., деятельность которой запрещена на территории РФ в части реализации данных социальных сетей на основании осуществления ею экстремистской деятельности