Note: The other languages of the website are Google-translated. Back to English
Войти  \/ 
x
or
x
Регистрация  \/ 
x

or

 Как перенести ячейки в один столбец на основе уникальных значений в другом столбце?

Предположим, у вас есть диапазон данных, содержащий два столбца, теперь вы хотите транспонировать ячейки в одном столбце в горизонтальные строки на основе уникальных значений в другом столбце, чтобы получить следующий результат. У вас есть какие-нибудь хорошие идеи, как решить эту проблему в Excel?

док транспонировать уникальные значения 1

Перенести ячейки в один столбец на основе уникальных значений с помощью формул

Перенести ячейки в один столбец на основе уникальных значений с кодом VBA

Перенести ячейки в один столбец на основе уникальных значений с помощью Kutools for Excel


С помощью следующих формул массива вы можете извлечь уникальные значения и транспонировать соответствующие данные в горизонтальные строки, сделайте следующее:

1. Введите эту формулу массива: = ИНДЕКС ($ A $ 2: $ A $ 16, ПОИСКПОЗ (0, СЧЁТЕСЛИ ($ D $ 1: $ D1, $ A $ 2: $ A $ 16), 0)) в пустую ячейку, например D2, и нажмите Shift + Ctrl + Enter вместе, чтобы получить правильный результат, см. снимок экрана:

док транспонировать уникальные значения 2

Внимание: В приведенной выше формуле A2: A16 столбец, из которого вы хотите перечислить уникальные значения, и D1 это ячейка над ячейкой формулы.

2. Затем перетащите маркер заполнения вниз к ячейкам, чтобы извлечь все уникальные значения, см. Снимок экрана:

док транспонировать уникальные значения 3

3. А затем продолжайте вводить эту формулу в ячейку E2: =IFERROR(INDEX($B$2:$B$16, MATCH(0, COUNTIF($D2:D2,$B$2:$B$16)+IF($A$2:$A$16<>$D2, 1, 0), 0)), 0), и не забудьте нажать Shift + Ctrl + Enter ключи, чтобы получить результат, см. снимок экрана:

док транспонировать уникальные значения 4

Внимание: В формуле выше: B2: B16 это данные столбца, которые вы хотите транспонировать, A2: A16 столбец, значения которого вы хотите транспонировать, и D2 содержит уникальное значение, которое вы извлекли на шаге 1.

4. Затем перетащите дескриптор заполнения справа от ячеек, в которых вы хотите отобразить транспонированные данные, пока не отобразится 0, см. Снимок экрана:

док транспонировать уникальные значения 5

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

док транспонировать уникальные значения 6


Возможно, формулы сложны для понимания, здесь вы можете запустить следующий код VBA, чтобы получить желаемый результат.

1. Удерживайте ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модульи вставьте следующий код в Модуль Окно.

Код VBA: транспонировать ячейки в один столбец на основе уникальных значений в другом столбце:

Sub transposeunique()
'updateby Extendoffice
    Dim xLRow As Long
    Dim i As Long
    Dim xCrit As String
    Dim xCol  As New Collection
    Dim xRg As Range
    Dim xOutRg As Range
    Dim xTxt As String
    Dim xCount As Long
    Dim xVRg As Range
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("please select data range(only two columns):", "Kutools for Excel", xTxt, , , , , 8)
    Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
    If xRg Is Nothing Then Exit Sub
    If (xRg.Columns.Count <> 2) Or _
       (xRg.Areas.Count > 1) Then
        MsgBox "the used range is only one area with two columns ", , "Kutools for Excel"
        Exit Sub
    End If
    Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
    If xOutRg Is Nothing Then Exit Sub
    Set xOutRg = xOutRg.Range(1)
    xLRow = xRg.Rows.Count
    For i = 2 To xLRow
        xCol.Add xRg.Cells(i, 1).Value, xRg.Cells(i, 1).Value
    Next
    Application.ScreenUpdating = False
    For i = 1 To xCol.Count
        xCrit = xCol.Item(i)
        xOutRg.Offset(i, 0) = xCrit
        xRg.AutoFilter Field:=1, Criteria1:=xCrit
        Set xVRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
        If xVRg.Count > xCount Then xCount = xVRg.Count
        xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible).Copy
        xOutRg.Offset(i, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
    Next
    xOutRg = xRg.Cells(1, 1)
    xOutRg.Offset(0, 1).Resize(1, xCount) = xRg.Cells(1, 2)
    xRg.Rows(1).Copy
    xOutRg.Resize(1, xCount + 1).PasteSpecial Paste:=xlPasteFormats
    xRg.AutoFilter
    Application.ScreenUpdating = True
End Sub

3. Затем нажмите F5 нажмите клавишу для запуска этого кода, и появится диалоговое окно с напоминанием о выборе диапазона данных, который вы хотите использовать, см. снимок экрана:

док транспонировать уникальные значения 7

4, Затем нажмите OK При нажатии кнопки появится другое окно с напоминанием о том, что нужно выбрать ячейку для отображения результата, см. снимок экрана:

док транспонировать уникальные значения 8

6. Нажмите OK кнопку, и данные в столбце B были перенесены на основе уникальных значений в столбце A, см. снимок экрана:

док транспонировать уникальные значения 9


Если у вас есть Kutools for Excel, объединяя Расширенные ряды комбинирования и Разделить клетки утилит, вы можете быстро выполнить эту задачу без каких-либо формул или кода.

Kutools for Excel : с более чем 300 удобными надстройками Excel, бесплатно и без ограничений в течение 30 дней.

После установки Kutools for Excel, пожалуйста, сделайте следующее:

1. Выберите диапазон данных, который вы хотите использовать. (Если вы хотите сохранить исходные данные, сначала скопируйте и вставьте данные в другое место.)

2. Затем нажмите Kutools > Слияние и разделение > Расширенные ряды комбинирования, см. снимок экрана:

3. В Объединить строки на основе столбца диалоговом окне выполните следующие действия:

(1.) Щелкните имя столбца, на основе которого вы хотите транспонировать данные, и выберите Основной ключ;

(2.) Щелкните другой столбец, который нужно транспонировать, и щелкните Сочетать затем выберите один разделитель для разделения объединенных данных, например пробел, запятую, точку с запятой.

док транспонировать уникальные значения 11

4. Затем нажмите Ok Кнопка, данные в столбце B были объединены в одну ячейку на основе столбца A, см. снимок экрана:

док транспонировать уникальные значения 12

5. Затем выберите объединенные ячейки и нажмите Kutools > Слияние и разделение > Разделить клетки, см. снимок экрана:

6. В Разделить клетки диалоговое окно, выберите Разделить на столбцы под Тип вариант, а затем выберите разделитель, который разделяет ваши объединенные данные, см. снимок экрана:

док транспонировать уникальные значения 14 14

7. Затем нажмите Ok и выберите ячейку, чтобы отобразить результат разделения в появившемся диалоговом окне, см. снимок экрана:

док транспонировать уникальные значения 15

8. Нажмите OK, и вы получите нужный вам результат. Смотрите скриншот:

док транспонировать уникальные значения 16

Загрузите бесплатную пробную версию Kutools for Excel прямо сейчас!


Kutools for Excel: с более чем 300 удобными надстройками Excel, которые можно попробовать бесплатно без ограничений в течение 30 дней. Загрузите и бесплатную пробную версию прямо сейчас!

Лучшие инструменты для работы в офисе

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Более 300 мощных функций. Поддерживает Office / Excel 2007-2019 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Alicia · 21 days ago
    Like many people in the below my column "b" has duplicates I still want to appear in a column, I.e. 

    How to do the transpose if B column doesn't have unique values but still need those values
    KTE 100
    KTE 100

    Can you shared a modified equation that works in that scenario? I appears lots of people have this question below without an answer.

    Thank you, 
    • To post as a guest, your comment is unpublished.
      skyyang · 21 days ago
      Hello, Alicia,
      If there are duplicate values in the second column, you should apply the below array formula:
      =IFERROR(INDEX($B$2:$B$16,SMALL(IF($D2=$A$2:$A$16,ROW($A$2:$A$16)-ROW($A$2)+1),COLUMN(A1))),"")
      After inserting the formula, please remember to press Shift + Ctrl + Enter keys.

      Please try, hope it can help you!

  • To post as a guest, your comment is unpublished.
    Alex · 1 months ago
    how would you do the first order but with multiple columns of data for each product? Like if KTO and KTE had multiple pieces of data in columns C, D, E,...

    This was the formula used:

    =IFERROR(INDEX($B$2:$B$16, MATCH(0, COUNTIF($D2:D2,$B$2:$B$16)+IF($A$2:$A$16<>$D2, 1, 0), 0)), 0)
  • To post as a guest, your comment is unpublished.
    Harish · 2 months ago
    thanks !! just what i was looking for !! works as intended !!
  • To post as a guest, your comment is unpublished.
    Gregg · 1 years ago
    this was a very, very helpful post - thank you!
    I found the VBA version did not yield the expected results at least when running in VBA 7.1 (Excel for Office 365 - 16.0.x - 64-bit). I tweaked it a bit to get the results I wanted:


    Sub transposeunique()
    'updateby Extendoffice
    'updateby skipow June 2020
    Dim xLRow As Long
    Dim i As Long
    Dim xCrit As String
    Dim xCritLast As String
    Dim xCol As New Collection
    Dim xRg As Range
    Dim xOutRg As Range
    Dim xTxt As String
    Dim xCount As Long
    Dim xVRg As Range
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("please select data range(only two columns):", "Kutools for Excel", xTxt, , , , , 8)
    Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
    If xRg Is Nothing Then Exit Sub
    If (xRg.Columns.Count <> 2) Or _
    (xRg.Areas.Count > 1) Then
    MsgBox "the used range is only one area with two columns ", , "Kutools for Excel"
    Exit Sub
    End If
    Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
    If xOutRg Is Nothing Then Exit Sub
    Set xOutRg = xOutRg.Range(1)
    xLRow = xRg.Rows.Count
    For i = 2 To xLRow
    'xCol.Add xRg.Cells(i, 1).Value, xRg.Cells(i, 1).Value
    'the above line commented out - the Add function to the Collection (at least in VBA 7.1) doesn't accept this format
    xCol.Add Item:=xRg.Cells(i, 1).Value
    'you only need the first column put into the Collection

    Next
    Application.ScreenUpdating = False
    For i = 1 To xCol.Count
    xCrit = xCol.Item(i)
    'if you don't keep track of the last entry and compare to the next entry you'll get duplicate lines
    If xCrit = xCritLast Then
    xRg.AutoFilter
    Else
    xOutRg.Offset(i, 0) = xCrit
    xRg.AutoFilter Field:=1, Criteria1:=xCrit
    Set xVRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
    If xVRg.Count > xCount Then xCount = xVRg.Count
    xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible).Copy
    xOutRg.Offset(i, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False
    'save the last entry and compare above to the next one to avoid duplicates
    xCritLast = xCrit
    End If
    Next
    xOutRg = xRg.Cells(1, 1)
    xOutRg.Offset(0, 1).Resize(1, xCount) = xRg.Cells(1, 2)
    xRg.Rows(1).Copy
    xOutRg.Resize(1, xCount + 1).PasteSpecial Paste:=xlPasteFormats
    xRg.AutoFilter
    Application.ScreenUpdating = True
    End Sub

    • To post as a guest, your comment is unpublished.
      Zoe · 2 months ago
      This works, but it gives me duplicates. Is there a way to make it not?
      • To post as a guest, your comment is unpublished.
        Harish · 2 months ago
        it worked for me, i had to sort the first column though
  • To post as a guest, your comment is unpublished.
    ygoyal578@gmail.com · 1 years ago
    can you please share the code if there are 2 columns to be copied instead of 1. below is the example.
  • To post as a guest, your comment is unpublished.
    gabimargareta204@gmail.com · 1 years ago
    I have a data set which has 3 columns presented below:

    Column A Column B Column C

    Country1 Year1 Value1
    Country1 Year2 Value2
    Country1 Year3 Value3,

    Country2 Year1 Value1
    Country2 Year3 Value3,
    ...........

    I need to combine these 3 columns in a table like this:

    Year1 Year2 Year3 ................................. YearX


    Country1 Value1 Value2 Value3
    Country2 Value1 #Missing Value3
    .....
    .....
    .....
    CountryX Valuex ..................



    The problem i am facing is that for some data in column A i don't have values for each year only for some.(For example country 2 has missing values for Year 2)


    Is there a way to work around this issue and resolve it?

    Thank you in advance!
  • To post as a guest, your comment is unpublished.
    emsequeira · 2 years ago
    I have a data set which has multiple IDs in column A, and has connected data in column B. I used the above formula and altered it a bit so that I am transposing the cells in the column B into a row based on the unique ID tied to it in column A. The formula used to identify the unique IDs is: =INDEX($A$2:$A$13409, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$13409), 0)). The formula used to do the transposing is: =IFERROR(INDEX($B$2:$B$13409, MATCH(0, IF($A$2:$A$13409<>$D2, 1, 0)+COUNTIF($D2:D2,$B$2:$B$13409), 0)), "N/A"). Both given in the article, only slightly altered.

    The issue is my data set in column B has duplicates, sometimes appearing one after another, and I need all of the values in the column to be presented in the rows.

    The image attached is what I would like the table to show (this is a small sample size, the true dataset has over 13,000 entries). What is happening now is when a repeat value is encountered, it will not count it.
    i.e. Row 9 for ID 11980 now only shows 0 -31.79 -0.19 -0.74 N/A N/A .... when what I need it to show instead is 0 0 -31.79 -0.19 -0.74 0 0 N/A N/A ....

    Is there a way to work around this issue and resolve it?

    Thank you in advance!
    • To post as a guest, your comment is unpublished.
      Alicia · 21 days ago
      Did you ever get a response/resolution to this challenge? I have the same one.

  • To post as a guest, your comment is unpublished.
    ariellerazzy · 2 years ago
    I have a data set in Columns A (Unique ID) - E. Each row has data based on the ID#, there are multiple rows for each ID# but I want one row per ID# with all of the other data in columns (it would be 5 columns long minimum and 25 maximum depending on how many each unique ID has). I found a code but it only works for two columns. I had to concatenate the four columns (not including ID) then delimit after running the macro (lot of work). For 15,000 rows of data this is extra time consuming. Is there an endless column macro that would work? Thanks in advance everyone for your help!
    ID CODE ST CODE# DATE
  • To post as a guest, your comment is unpublished.
    martha Bright · 2 years ago
    The macro did not work. It just copied the contents in cell A1.
  • To post as a guest, your comment is unpublished.
    Vinod · 2 years ago
    =INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) worked for me to transpose the unique values of A column into a new column BUT...is there a way to get the all the values in B column to be transposed as given below:

    Product Order Date Product Order Order Order Order Order Order Order
    KTE 100 3/3/2019 KTE 100 100 100 200 100 150 100
    KTO 150 3/3/2019 KTO 150 100 200 100 150 200
    KTE 100 3/4/2019 BOT 150 100 200 150 100 200
    KTO 100 3/4/2019 COD 200 150 100 150
    KTO 200 3/5/2019
    KTE 100 3/5/2019
    BOT 150 3/5/2019
    BOT 100 3/6/2019
    KTO 100 3/6/2019
    KTE 200 3/6/2019
    BOT 200 3/7/2019
    COD 200 3/7/2019
    KTE 100 3/7/2019
    KTO 150 3/7/2019
    BOT 150 3/8/2019
    KTE 150 3/8/2019
    COD 150 3/8/2019
    BOT 100 3/9/2019
    BOT 200 3/10/2019
    COD 100 3/10/2019
    KTO 200 3/10/2019
    COD 150 3/11/2019
    KTE 100 3/11/2019
  • To post as a guest, your comment is unpublished.
    seanviz18@gmail.com · 2 years ago
    So I am working for a company. We have columns for info such as Last name, first name, rank, section, phone number, address. Is there a way I can use a similar formula to transpose the entire row of info to a column by names?
  • To post as a guest, your comment is unpublished.
    kumar · 2 years ago
    Hi can we add each row and give the output in one column, with the above functionality.
  • To post as a guest, your comment is unpublished.
    raj · 2 years ago
    Need to get the same out put but for predefined columns to be selected would be ($A,$B) and need the output column Position on $D$1.
    If any one have idea's that would be a great help!!!!
  • To post as a guest, your comment is unpublished.
    Kate · 3 years ago
    =INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) worked for me to transpose the unique values of a column into a new column BUT...is there a way to ad in a sort function so that the new column created is transposed in ascending order?


    Thanks!
  • To post as a guest, your comment is unpublished.
    Prial · 3 years ago
    Same as Dave, I need to do the exactly opposite of this. Table 2 to transpose to Table 1. Input Table 2, Output Table 1.
  • To post as a guest, your comment is unpublished.
    dababler@gmail.com · 3 years ago
    I need to do exactly the opposite of this. I have many many columns associated with a row id and I want to paste them into two columns
    for example I have
    rowid, value, value1, value2, value3, value4, value..225
    100, Dolphin, 255, 9--, sarah, jameson, ....
    179, Router, flood, jason, 89, nose



    I want it to look like this
    100, Dolphin
    100, 255
    100, 9--
    100, sarah
    100, jaemeson
    179, Router
    179, flood
    179, jason
    179, 89
    179, nose
    • To post as a guest, your comment is unpublished.
      skyyang · 3 years ago
      Hello, Dave,
      To solve your problem, please use the below VBA code: (Note: When you select the data range that you want to transpose, please exclude the header row.)

      Sub TransposeUnique_2()
      Dim xLRow, xLCount As Long
      Dim xRg As Range
      Dim xOutRg As Range
      Dim xObjRRg As Range
      Dim xTxt As String
      Dim xCount As Long
      Dim xVRg As Range
      On Error Resume Next
      xTxt = ActiveWindow.RangeSelection.Address
      Set xRg = Application.InputBox("please select data range:", "Kutools for Excel", xTxt, , , , , 8)
      Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
      If xRg Is Nothing Then Exit Sub
      If (xRg.Rows.count < 2) Or _
      (xRg.Areas.count > 1) Then
      MsgBox "Invalid selection", , "Kutools for Excel"
      Exit Sub
      End If
      Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
      If xOutRg Is Nothing Then Exit Sub
      Application.ScreenUpdating = False
      xLCount = xRg.Columns.count
      For xLRow = 1 To xRg.Rows.count
      Set xObjRRg = Range(xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)
      xObjRRg.Copy
      xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
      Application.CutCopyMode = False
      Range(Cells(xOutRg.Row, xOutRg.Column), Cells(xOutRg.Row + xObjRRg.count - 1, xOutRg.Column)).Value = xRg.Cells(xLRow, 1).Value
      Set xOutRg = xOutRg.Offset(RowOffset:=xObjRRg.count)
      Next
      Application.ScreenUpdating = True
      End Sub
      • To post as a guest, your comment is unpublished.
        ygoyal578@gmail.com · 1 years ago
        Hello Skyyang,
        please share the code for 3 columns. Below is the example:

        I want the data like: yogesh@gmail.com community 1 view only community 2 view only ......
        goyal@gmail.com community 1 view only community 2 view only........

        • To post as a guest, your comment is unpublished.
          skyyang · 1 years ago
          Hello, ygoyal,
          To solve your problem, please apply the below code:
          Sub TransposeUnique_2()
          Dim xLRow, xLCount As Long
          Dim xRg As Range
          Dim xOutRg As Range
          Dim xObjRRg As Range
          Dim xTxt As String
          Dim xCount As Long
          Dim xVRg As Range
          Dim xC, xI, xI1, xI2 As Integer
          On Error Resume Next
          xTxt = ActiveWindow.RangeSelection.Address
          Set xRg = Application.InputBox("please select data range:", "Kutools for Excel", xTxt, , , , , 8)
          Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
          If xRg Is Nothing Then Exit Sub
          If (xRg.Rows.Count < 2) Or _
          (xRg.Areas.Count > 1) Then
          MsgBox "Invalid selection", , "Kutools for Excel"
          Exit Sub
          End If
          Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
          If xOutRg Is Nothing Then Exit Sub
          Application.ScreenUpdating = False
          xLCount = xRg.Columns.Count
          For xLRow = 1 To xRg.Rows.Count
          Set xObjRRg = Range(xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)
          On Error Resume Next
          xC = (xObjRRg.Count Mod 2)
          If xC <> 0 Then
          xC = Int(xObjRRg.Count / 2) + 1
          Else
          xC = Int(xObjRRg.Count / 2)
          End If
          xI1 = 1
          xI2 = 2
          For xI = 1 To xC
          Range(xObjRRg.Item(xI1), xObjRRg.Item(xI2)).Copy
          xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
          Application.CutCopyMode = False
          xOutRg.Value = xRg.Cells(xLRow, 1).Value
          Set xOutRg = xOutRg.Offset(RowOffset:=1)
          xI1 = xI1 + (2)
          xI2 = xI2 + (2)
          Next
          Next
          Application.ScreenUpdating = True
          End Sub

          Please try, hope it can help you!
          • To post as a guest, your comment is unpublished.
            ygoyal578@gmail.com · 1 years ago
            Hello
          • To post as a guest, your comment is unpublished.
            ygoyal578@gmail.com · 1 years ago
            Hello Bro, still waiting for your help
          • To post as a guest, your comment is unpublished.
            Yogesh · 1 years ago
            Bro, pls help in this.
          • To post as a guest, your comment is unpublished.
            ygoyal578@gmail.com · 1 years ago
            Hello Bro, The code is working opposite. Please refer the attached screen shot of requirement.
            The data available is row-wise and want to transpose the data in columns .
            • To post as a guest, your comment is unpublished.
              skyyang · 1 years ago
              Hi, ygoyal,
              Sorry for replying late, please apply the following code, please try it!

              Sub transposeunique()
              'updateby Extendoffice
              Dim xLRow As Long
              Dim i As Long
              Dim xCrit As String
              Dim xCol As New Collection
              Dim xRg As Range
              Dim xOutRg As Range
              Dim xTxt As String
              Dim xCount As Long
              Dim xVRg As Range
              Dim xFRg, xSRg, xCRg As Range
              On Error Resume Next
              xTxt = ActiveWindow.RangeSelection.Address
              Set xRg = Application.InputBox("please select data range(only 3 columns):", "Kutools for Excel", xTxt, , , , , 8)
              Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
              If xRg Is Nothing Then Exit Sub
              If (xRg.Columns.Count <> 3) Or _
              (xRg.Areas.Count > 1) Then
              MsgBox "the used range is only one area with two columns ", , "Kutools for Excel"
              Exit Sub
              End If
              Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
              If xOutRg Is Nothing Then Exit Sub
              Set xOutRg = xOutRg.Range(1)
              xLRow = xRg.Rows.Count
              For i = 2 To xLRow
              xCol.Add xRg.Cells(i, 1).Value, xRg.Cells(i, 1).Value
              Next
              Application.ScreenUpdating = False
              Application.ScreenUpdating = False
              For i = 1 To xCol.Count
              xCrit = xCol.Item(i)
              xOutRg.Offset(i, 0) = xCrit
              xRg.AutoFilter Field:=1, Criteria1:=xCrit
              Set xVRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
              If xVRg.Count > xCount Then xCount = xVRg.Count
              Set xSRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
              Set xCRg = xOutRg.Offset(i, 1)
              For Each xFRg In xSRg
              xFRg.Copy
              xCRg.PasteSpecial
              xRg.Range("B1").Copy
              xCRg.Offset(-(i), 0).PasteSpecial
              xFRg.Offset(0, 1).Copy
              Set xCRg = xCRg.Offset(0, 1)
              xCRg.PasteSpecial
              xRg.Range("c1").Copy
              xCRg.Offset(-(i), 0).PasteSpecial
              Set xCRg = xCRg.Offset(0, 1)
              Next
              Application.CutCopyMode = False
              Next
              xRg.Item(1).Copy
              xOutRg.PasteSpecial
              xRg.AutoFilter
              Application.ScreenUpdating = True
              End Sub
              • To post as a guest, your comment is unpublished.
                carlos7z · 7 months ago
                Hi Skyyang, Love this, any chance you could get it to work for four columns? again just using the first two as a comparator, or better still the ability to choose the number of columns before selecting them? I took a look at your script, wouldn't have a clue on how to achieve this...
              • To post as a guest, your comment is unpublished.
                carlos7z · 7 months ago
                Hi Skyyang, Love this, any chance you could get it to work for four columns? again just using the first two as a comparator, or better still the ability to choose the number of columns before selecting them? I took a look at your script, wouldn't have a clue on how to achieve this...
              • To post as a guest, your comment is unpublished.
                ygoyal578@gmail.com · 1 years ago
                Hey Bro I tried using this code but the excel goes hang when I run this code and could not see the output from the above code. please suggest what to do in this case.
                • To post as a guest, your comment is unpublished.
                  skyyang · 1 years ago
                  Hi,
                  The code works well in my workbook, which Excel version do you use?
                  • To post as a guest, your comment is unpublished.
                    ygoyal578@gmail.com · 1 years ago
                    MS Excel 2016
                    • To post as a guest, your comment is unpublished.
                      skyyang · 1 years ago
                      The code works fine in my Excel 2016 as well, please try it with some smalll range data first.
                      • To post as a guest, your comment is unpublished.
                        ygoyal578@gmail.com · 1 years ago
                        Have tested on 160 records but in that still duplicate was there.
      • To post as a guest, your comment is unpublished.
        Anna · 3 years ago
        Thank you, it works perfectly, you saved me 2 days! :)
  • To post as a guest, your comment is unpublished.
    GDamasco85 · 3 years ago
    With the formula below:

    =IFERROR(INDEX($B$2:$B$45, MATCH(0, COUNTIF($D2:D2,$B$2:$B$45)+IF($A$2:$A$10<>$D2, 1, 0), 0)), 0)

    How can I transpose the data using approximate matches? Say, I want to extract all the values from Column B that match the first 9 characters / digits from Column A? Column B has 11 characters while A only 9. thank you!
  • To post as a guest, your comment is unpublished.
    Guest · 3 years ago
    i want to transpose duplicate values too (all values - unique + duplicate) and not just unique values. Can you give the formula for that too.
    • To post as a guest, your comment is unpublished.
      joyalisac25 · 7 months ago
      I need the same
      • To post as a guest, your comment is unpublished.
        Alicia · 21 days ago
        Did you ever get a response/resolution to this challenge? I have the same one.
  • To post as a guest, your comment is unpublished.
    aidan5800 · 3 years ago
    Is there a way of doing this in reverse? I.e. data in rows of varying length and so sorting it into two columns? See attached.
  • To post as a guest, your comment is unpublished.
    mathewdidin@gmail.com · 3 years ago
    How to do the transpose if B column doesn't have unique values but still need those values
    KTE 100
    KTE 100
    Assuming that they are two different transaction
    • To post as a guest, your comment is unpublished.
      joyalisac25 · 7 months ago
      I too need the same. I want to display 100 twice is if there in the data

      • To post as a guest, your comment is unpublished.
        joyalisac25 · 7 months ago
        Can you suggest a formula for that

        • To post as a guest, your comment is unpublished.
          Alicia · 21 days ago
          Did you ever get a response/resolution to this challenge? I have the same one.
    • To post as a guest, your comment is unpublished.
      skyyang · 3 years ago
      Hi,Didin,

      Can you give your problem more clearly or detailed?
      You can insert an example screenshot for your problem.
      Thank you!
      • To post as a guest, your comment is unpublished.
        Bharath · 3 months ago
        Hi there,

        Could you please help me with below requirement.

        Product ----- order
        KTE           ------ 100
        KTE           ------ 200
        KTO           ------ 300
        KTO          ------   300

        expected output

        Product ----- order ----- order ------ order
        KTE      ------ 100  ------ 200
        KTO     ------ 300   ------ 300







  • To post as a guest, your comment is unpublished.
    Sanjeev Chidambaram · 4 years ago
    I just want to do the opposite. Like i have the end result already, and i want to achieve the first step.
    • To post as a guest, your comment is unpublished.
      Chris · 4 years ago
      I am looking for the same thing
      • To post as a guest, your comment is unpublished.
        Juan Carlos · 3 years ago
        Did you find any solution for the opposite scenario? Thanks!
        • To post as a guest, your comment is unpublished.
          Prial · 3 years ago
          I want to do the opposite as well. Any solution you got gents?
          • To post as a guest, your comment is unpublished.
            skyyang · 3 years ago
            Hello, guys,
            To get the opposite result based on the example of this article, you can apply the following VBA code: (Note:When selecting the data range that you want to transpose, please exclude the header row)

            Sub TransposeUnique_2()
            Dim xLRow, xLCount As Long
            Dim xRg As Range
            Dim xOutRg As Range
            Dim xObjRRg As Range
            Dim xTxt As String
            Dim xCount As Long
            Dim xVRg As Range
            On Error Resume Next
            xTxt = ActiveWindow.RangeSelection.Address
            Set xRg = Application.InputBox("please select data range:", "Kutools for Excel", xTxt, , , , , 8)
            Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
            If xRg Is Nothing Then Exit Sub
            If (xRg.Rows.count < 2) Or _
            (xRg.Areas.count > 1) Then
            MsgBox "Invalid selection", , "Kutools for Excel"
            Exit Sub
            End If
            Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
            If xOutRg Is Nothing Then Exit Sub
            Application.ScreenUpdating = False
            xLCount = xRg.Columns.count
            For xLRow = 1 To xRg.Rows.count
            Set xObjRRg = Range(xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)
            xObjRRg.Copy
            xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
            Range(Cells(xOutRg.Row, xOutRg.Column), Cells(xOutRg.Row + xObjRRg.count - 1, xOutRg.Column)).Value = xRg.Cells(xLRow, 1).Value
            Set xOutRg = xOutRg.Offset(RowOffset:=xObjRRg.count)
            Next
            Application.ScreenUpdating = True
            End Sub
  • To post as a guest, your comment is unpublished.
    Pradeep · 4 years ago
    First step itself fails
    =INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) gives Value Not Available error
  • To post as a guest, your comment is unpublished.
    Piyush · 4 years ago
    This was fantastic.
    I had an excel with around 2000 unique values in row A and couldn't have managed this exercise without your help.

    Many many thanks.
  • To post as a guest, your comment is unpublished.
    Tim · 4 years ago
    How would I go in the opposite direction? From multiple columns into a single column? Thanks in advance!

    Tim