1

У меня есть два столбца данных, которые перекрываются, выглядя примерно так:

-------------------------
| Aardvarks  | Bears    |
| Bears      | Dogs     |
| Cats       | Giraffes |
| Giraffes   | Hippos   |
| Monkeys    | Rhinos   |
| Rhinos     | Zebras   |
-------------------------

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

-------------------------
| Aardvarks |           |
| Bears     | Bears     |
| Cats      |           |
|           | Dogs      |
| Giraffes  | Giraffes  |
|           | Hippos    |
| Monkeys   |           |
| Rhinos    | Rhinos    |
|           | Zebras    |
-------------------------

Я видел, как люди задают подобные вопросы здесь, но все полагаются на столбец A имеющий какие-то "полные" данные, и столбец B, имеющий неполные данные, которые требуют сортировки.

Моя проблема заключается в том, что оба столбца содержат дублирующиеся и уникальные данные (в приведенном выше примере столбец A содержит не всех животных).

Есть ли способ выровнять и расположить столбцы, чтобы получить конечный результат, который я ищу?

2 ответа2

2

Извините, что трачу время на людей, но после еще большего поиска в Интернете я нашел решение своей проблемы.

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

http://sites.madrocketscientist.com/jerrybeaucaires-excelassistant/text-functions/line-up-matches

0

Сайт, кажется, не работает ... к счастью, я сохранил полезный VB в прошлом году

Option Explicit

Sub LineEmUp()
'Author:    Jerry Beaucaire
'Date:      7/5/2010
'Summary:   Line up a random number of columns so all matching
'           items are on the same rows
Dim LC  As Long
Dim Col As Long
Dim LR  As Long
Application.ScreenUpdating = False

'Spot last column of data
    LC = Cells(1, Columns.Count).End(xlToLeft).Column

'Add new key column  to collect unique values
    Cells(1, LC + 1) = "Key"
    For Col = 1 To LC
        Range(Cells(2, Col), Cells(Rows.Count, Col)).SpecialCells(xlConstants).Copy _
           Cells(Rows.Count, LC + 1).End(xlUp).Offset(1)
    Next Col

    Columns(LC + 1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, LC + 2), Unique:=True
    Columns(LC + 2).Sort Key1:=Cells(2, LC + 2), Order1:=xlAscending, Header:=xlYes

'Fill in new table headers w/formatting
    Range("A1", Cells(1, LC)).Copy Cells(1, LC + 3)

'Fill in new table values
    LR = Cells(Rows.Count, LC + 2).End(xlUp).Row
    With Range(Cells(2, LC + 3), Cells(LR, LC + 2 + LC))
        .FormulaR1C1 = "=IF(ISNUMBER(MATCH(RC" & LC + 2 & ",C[-" & LC + 2 _
                        & "],0)), RC" & LC + 2 & ", """")"
        .Value = .Value
    End With

'Cleanup/Erase old values
    Range("A1", Cells(1, LC + 2)).EntireColumn.Delete xlShiftToLeft
    Columns.Autofit
    Application.ScreenUpdating = True
End Sub

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .