VBA i Excel

[corsarlt]

Здравствуйте, експерты. Помогите пожалуйста с кодом. есть 2 столбца: A1; C1, в которых записаны названия месяцов. Код ищет НЕ совпадающие названия В ОБОИХ столбцах и записывает их в отдельный столбец E1. Однако когда я перемещаю данные из столбца C1 в столбец B1, код записывает слова только из одного столбца A1 и вразброс. Нужно, чтобы данные были в столбцах A1; B1, а не повторяющие слова вписывались в столбец C1

Заранее благодарен за любые ответы.


-------------------------
Sub spisok()
k = 1
For i = 1 To 10
Set S = Range("C1:C10").Find _
(What:=Cells(i, 1).Value, LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If S Is Nothing Then
Cells(k, 5).Value = Cells(i, 1).Value
k = k + 1
End If
Set S = Range("A1:A10").Find _
(What:=Cells(i, 3).Value, LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If S Is Nothing Then
Cells(k, 5).Value = Cells(i, 3).Value
k = k + 1
End If
Next i
End Sub

[SAS888]

Не понятно, что нужно. Поменять в Вашем коде номера столбцов?
Если у Вас с этим проблема, то советую, например, вместо

Cells(k, 5).Value = Cells(i, 3).Value

использовать

Cells(k, "E").Value = Cells(i, "C").Value

для большей наглядности.

[corsarlt]

Сообщение от SAS888

Не понятно, что нужно. Поменять в Вашем коде номера столбцов?
Если у Вас с этим проблема, то советую, например, вместо

Cells(k, 5).Value = Cells(i, 3).Value

использовать

Cells(k, "E").Value = Cells(i, "C").Value

для большей наглядности.

Спасибо за ответ. Но код выводит все записи подряд, а мне надо, чтобы выводил не повторяющиеся слова с обеих столбцов.

[SAS888]

Если я правильно понял, то нужно в столбец "C" занести все уникальные значения из столбцов "A" и "B".
Если так, то эту задачу можно решить оригинальным способом:
Сначала создадим коллекцию из значений столбцов "A" и "B", затем вставим в столбец "C" все члены нашей коллекции.
Такой способ хорош тем, что не нужно делать никаких проверок и поисков. Просто, двух одинаковых членов коллекции быть не может. Поэтому, достаточно проигнорировать возможную ошибку при добавлении в коллекцию уже существующего члена (в коде это оператор "On Error Resume Next").

Sub Spisok()

    Dim myCol As New Collection, i As Long, El As Variant
    
    On Error Resume Next
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        myCol.Add Cells(i, "A"), CStr(Cells(i, "A"))
    Next
    For i = 1 To Cells(Rows.Count, "B").End(xlUp).Row
        myCol.Add Cells(i, "B"), CStr(Cells(i, "B"))
    Next
    On Error GoTo 0
    
    i = 1
    For Each El In myCol
        Cells(i, "C") = El
        i = i + 1
    Next

End Sub