Excel: транспонировать столбец в строку и фильтровать таблицу на основе новой строки - PullRequest
0 голосов
/ 20 декабря 2018

У меня есть следующая таблица

A     B     C     D
-------------------
sa  s21    os   v12  
sa  s21    hs   v14  
rd  s22    ft   v16  
zt  s23    pq   v13  
zt  s23    et   v15  
hp  s26    zu   v17

Столбец A: существуют двойные значения

Столбец C: есть уникальные

Я хочу переместить столбец «A» в новую строку (уникальное значение) в качестве заголовка столбца на другом листе (вспомогательный), а затем отфильтровать, как показано ниже:

sa    rd     zt    hp
----------------------
os    ft     pq    zu
hs    -      et    -

какое-либо решение?как формульный или VBA?

1 Ответ

0 голосов
/ 20 декабря 2018

Попробуйте следующий код:

Option Explicit

Sub test()

    Dim LastColumn2 As Long, LastRow1 As Long, LastRow2 As Long, i As Long, j As Long
    Dim Code1 As String, Code2 As String
    Dim Excist As Boolean

    LastRow1 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row

    For i = 1 To LastRow1
        Code1 = Sheet1.Range("A" & i).Value
        LastColumn2 = Sheet2.Cells(1, Sheet2.Columns.Count).End(xlToLeft).Column
        Excist = True
            For j = 1 To LastColumn2
                Code2 = Sheet2.Cells(1, j).Value
                If Code1 = Code2 Then
                    LastRow2 = Sheet2.Cells(Sheet2.Rows.Count, j).End(xlUp).Row
                    Sheet2.Cells(LastRow2 + 1, j).Value = Sheet1.Range("A" & i).Offset(0, 2).Value
                    Excist = True
                    Exit For
                Else
                    Excist = False
                End If
            Next j

            If Excist = False Then
                If LastColumn2 = 1 And Sheet2.Range("A1").Value = "" Then
                    Sheet2.Cells(1, 1).Value = Sheet1.Range("A" & i).Value
                    Sheet2.Cells(2, 1).Value = Sheet1.Range("A" & i).Offset(0, 2).Value
                Else
                    Sheet2.Cells(1, LastColumn2 + 1).Value = Sheet1.Range("A" & i).Value
                    Sheet2.Cells(2, LastColumn2 + 1).Value = Sheet1.Range("A" & i).Offset(0, 2).Value
                End If
            End If
    Next i
End Sub

Данные отображаются на листе 1:

enter image description here

и экспорт на листе 2:

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...