EXCEL VBA: цикл по столбцам и копирование

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

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

Я получаю ошибку компиляции. Далее без For. Вот мой код:

Sub Compare()

    Dim colA As Integer, colB As Integer

    colA = Columns("A:A").Rows.Count
    colB = Columns("C:C").Rows.Count


        For I = 2 To colA 'loop through column A

            For j = 2 To colB 'loop through column C

                ' If a match is found:
                If Worksheets("Sheet1").Cells(I, 1) = Workshee("Sheet1").Cells(j, 3) Then
                    ' Copy 
                    Worksheets("Sheet1").Cells(j, 4) = Worksheets("Sheet1").Cells(I, 2)
                    'Exit For

            Next j

        Next I

End Sub

excel vba excel-2010
person kit    schedule 26.08.2016    source источник
comment
вы не закрываете свой If. Добавьте End If перед Next j. Кстати, быстрый поиск в Google Next без For дал бы тот же ответ.   -  person arcadeprecinct    schedule 26.08.2016
comment
Вам не нужен VBA для этого. Достаточно использовать соответствующую формулу во втором столбце. Поиск ВПР() и ЕСЛИОШИБКА()   -  person Patrick Honorez    schedule 26.08.2016
comment
Вы зацикливаете целые строки в столбцах A и B, но устанавливаете их значения как Integer. Попробуйте объявить их как Long. Используйте также правильный оператор LastRow   -  person Anastasiya-Romanova 秀    schedule 26.08.2016

Ответы (2)


arrow_upward
2
arrow_downward

Как уже указывалось в комментариях выше, вы также можете сделать это с помощью VLookUp или комбинации INDEX/MATCH. Тем не менее, если вы хотите придерживаться VBA, вам следует немного изменить свой код.

Option Explicit

Sub Compare()

Dim ws As Worksheet
Dim i As Long, j As Long
Dim colA As Long, colC As Long

Set ws = ThisWorkbook.Worksheets("Sheet1")
colA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
colC = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

'loop through column A
For i = 2 To colA
    'loop through column C
    For j = 2 To colC
        ' If a match is found:
        If ws.Cells(i, 1).Value2 = ws.Cells(j, 3).Value2 Then
            ' Copy column B to Column D as written in your code above
            ws.Cells(j, 4).Value2 = ws.Cells(i, 2).Value2
            ' or copy column D to Column B as written in the question / post
            ws.Cells(i, 2).Value2 = ws.Cells(j, 4).Value2
            'Exit For
        End If
    Next j
Next i

ws.Range("D2:D" & colC).FormulaR1C1 = "=INDEX(R2C2:R" & colA & "C2,MATCH(RC[-1],R2C1:R" & colA & "C1,0))"

End Sub

Приведенный выше код будет выполнять оба действия:

  1. способ VBA и
  2. напишите INDEX/MATCH формулы для вас.

Просто удалите ненужный сегмент кода.

person Ralph    schedule 26.08.2016
comment
Спасибо. Однако это дает ошибку компиляции. Пишет Неверная или неквалифицированная ссылка. Любая идея, почему это может быть? - person kit; 26.08.2016
comment
Извините моя ошибка. Я начал писать код с оператора With, а затем изменил его на Set ws = ThisWorkbook.Worksheets("Sheet1"). Итак, было несколько методов, которые все еще начинались с . вместо ws.. Я изменил это. Теперь это должно работать. - person Ralph; 26.08.2016
comment
Обратите внимание, что существует разница между решением VBA и решением с формулой, если найдено более одного совпадения. Формула покажет первое совпадение, а решение VBA даст вам последнее совпадение (поскольку оно перезаписывает значение в D каждый раз, когда найдено совпадение). - person Ralph; 26.08.2016
comment
Это удаляет значения из четвертого столбца, но не копирует и не вставляет их во второй столбец. - person kit; 26.08.2016
comment
Верный. Как и ваш исходный код выше. Тем не менее, если вы хотите скопировать столбец D в столбец B, вам придется немного изменить код (из исходного сообщения). Оба варианта теперь находятся в скорректированном решении, опубликованном выше. - person Ralph; 26.08.2016

arrow_upward
0
arrow_downward

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

Sub Compare()
Dim LastRowA As Long, LastRowB As Long, i As Long, j As Long

With Worksheets("Sheet1")
    LastRowA = .Range("A" & Rows.Count).End(xlUp).Row
    LastRowC = .Range("C" & Rows.Count).End(xlUp).Row

    For i = 2 To LastRowA

        For j = 2 To LastRowC

                If .Cells(i, 1) = .Cells(j, 3) Then .Cells(i, 2) = .Cells(j, 4): Exit For

        Next j

    Next i

End With

End Sub

Дайте мне знать в разделе комментариев, если есть какие-либо ошибки.

person Anastasiya-Romanova 秀    schedule 26.08.2016
comment
Спасибо. Пишет "Ошибка компиляции: подпрограмма или функция не определены" - person kit; 26.08.2016
comment
@ Ральф Нет, я этого не делал. Я никогда этого не делал и никогда не сделаю. Смотрите мой комментарий под ОП. Если вы думаете, что я скопировал ваш, я полностью удалю этот ответ. Правда в том, что я скопировал код ОП и отредактировал его соответствующим образом. Просто так получилось, что вы первым опубликовали ответ, пока я писал этот ответ. И я сожалею, что ответил на этот вопрос в первую очередь. Но спасибо за совет. - person Anastasiya-Romanova 秀; 26.08.2016
comment
@ Ральф В этом нет необходимости. Я уже забыл это дело. Никаких болезненных ощущений точно. Спасибо за подарок. Я ценю его. :) - person Anastasiya-Romanova 秀; 28.08.2016