Изменение кода из поиска одинаковых значений в поиск разных

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменение кода из поиска одинаковых значений в поиск разных (Макросы/Sub)

medved_program

Дата: Понедельник, 06.04.2015, 14:40 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 5

Репутация: 0 ±

Замечаний: 40% ±

Excel 2007

Доброго времени суток. Написал код по поиску одинаковых значений в столбцах на разных листах и выводом результата на 3 лист, т.е. на первом листе сравнивается столб А со столбом А, который находится на 2 листе, и выводит результат на 3 лист в столб А. И теперь его нужно переделать, т.е. чтобы находил не одинаковые а разные значения. пример я прикрепил

[vba]

Код

Private Sub CommandButton1_Click()
Dim lLastRowA As Long
Dim lLastRowC As Long
Dim i As Long
Dim rFind As Excel.Range
Dim a, b, c As String
a = UserForm1.ComboBox1.Text
b = UserForm1.ComboBox2.Text
c = UserForm1.ComboBox3.Text
Set sh = Sheets.Add
lLastRowA = Лист1.Cells(Rows.Count, "A").End(xlUp).Row
lLastRowC = Лист2.Cells(Rows.Count, "C").End(xlUp).Row + 1
Application.ScreenUpdating = False
For i = 2 To lLastRowA Step 1
Set rFind = Лист2.Columns("A").Find(What:=Лист1.Cells(i, "A").Text, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
Лист3.Cells(Sheets(a)RowC, "A").Value = Лист1.Cells(i, "A").Value
lLastRowC = lLastRowC + 1
End If
Next i
MsgBox "Работа программы завершена!", vbInformation
Application.ScreenUpdating = True

End Sub

[/vba]

К сообщению приложен файл: 2420362.xlsx (10.6 Kb)

Сообщение отредактировал medved_program - Понедельник, 06.04.2015, 15:09

Ответить

nilem

Дата: Понедельник, 06.04.2015, 15:30 | Сообщение № 2

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

например, вот так:
[vba]

Код

Sub ertert()
Dim s$, t$, x, i&
With Sheets("Sheet1")
     s = "~" & Join(Application.Transpose(.Range("A1", .Cells(Rows.Count, 1).End(xlUp))), "~") & "~"
End With
With Sheets("Sheet2")
     x = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
End With

For i = 1 To UBound(x)
     t = "~" & x(i, 1) & "~"
     If InStr(s, t) Then
         Replace s, t, "~"
     Else
         s = s & x(i, 1) & "~"
     End If
Next i

x = Split(Mid(s, 2, Len(s) - 2), "~")
Sheets("Sheet3").Range("A1").Resize(UBound(x) + 1).Value = Application.Transpose(x)
End Sub

[/vba]