Есть макрос, который позволяет провести такую сортировку данных:
находит данные приведенные во второй колонке среди данных в первой колонке и выводит их напротив в третьей колонке. Вот сам макрос:
[vba]
Код
Sub zz00() Dim i As Long, j As Long, kA As Long, kB As Long, B() As String, sT As String kA = Cells(Rows.Count, 1).End(xlUp).Row ReDim B(kA) kB = 0 For i = 1 To kA sT = Cells(i, 2) If sT <> "" Then kB = kB + 1 B(kB) = sT End If Next i For i = 1 To kA sT = Cells(i, 1) For j = 1 To kB If sT = B(j) Then Cells(i, 3) = B(j) Next j Next i End Sub
[/vba]
Вот как это выглядит в результате такой сортировки:
Но, есть одна проблема. Если данные из второй колонки оказываются не найденными среди данных первой колонки, то они просто теряются (такие пометил желтым) :
Нужно изменить макрос, чтобы не найденные данные выводились в четвертую колонку.
В результате должно получаться примерно так:
Заранее всем огромное спасибо!! ! [admin] Тема закрыта. Причина: Нарушение правил пп. 2, 3, 5r[/admin]
Есть макрос, который позволяет провести такую сортировку данных:
находит данные приведенные во второй колонке среди данных в первой колонке и выводит их напротив в третьей колонке. Вот сам макрос:
[vba]
Код
Sub zz00() Dim i As Long, j As Long, kA As Long, kB As Long, B() As String, sT As String kA = Cells(Rows.Count, 1).End(xlUp).Row ReDim B(kA) kB = 0 For i = 1 To kA sT = Cells(i, 2) If sT <> "" Then kB = kB + 1 B(kB) = sT End If Next i For i = 1 To kA sT = Cells(i, 1) For j = 1 To kB If sT = B(j) Then Cells(i, 3) = B(j) Next j Next i End Sub
[/vba]
Вот как это выглядит в результате такой сортировки:
Но, есть одна проблема. Если данные из второй колонки оказываются не найденными среди данных первой колонки, то они просто теряются (такие пометил желтым) :
Нужно изменить макрос, чтобы не найденные данные выводились в четвертую колонку.
В результате должно получаться примерно так:
Заранее всем огромное спасибо!! ! [admin] Тема закрыта. Причина: Нарушение правил пп. 2, 3, 5r[/admin]anvvar
Можно было и просто формулами найти... А если макросом - можно как-то так: [vba]
Код
Sub zz01() kA = Cells(Rows.Count, 1).End(xlUp).Row Set rA = Cells(1, 1).Resize(kA) kB = Cells(Rows.Count, 2).End(xlUp).Row Set rB = Cells(1, 2).Resize(kB) r = 1 For Each c In rB.Cells Set f = rA.Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole) If f Is Nothing Then Cells(r, 4) = c.Value r = r + 1 Else Cells(1, 3).Offset(f.Row - 1) = c.Value End If Next End Sub
[/vba]
Можно было и просто формулами найти... А если макросом - можно как-то так: [vba]
Код
Sub zz01() kA = Cells(Rows.Count, 1).End(xlUp).Row Set rA = Cells(1, 1).Resize(kA) kB = Cells(Rows.Count, 2).End(xlUp).Row Set rB = Cells(1, 2).Resize(kB) r = 1 For Each c In rB.Cells Set f = rA.Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole) If f Is Nothing Then Cells(r, 4) = c.Value r = r + 1 Else Cells(1, 3).Offset(f.Row - 1) = c.Value End If Next End Sub