基於excel中第一行值的單元格行到列的范圍

Question

我有像excel一樣的細胞范圍

A   A   A   B   B   B
A1  A2  A3  B1  B2  B3

有什么想法如何將這個范圍的細胞轉換成 -

A   B
A1  B1
A2  B2
A3  B3

我嘗試用excel中的Kutools插件來做，但它無法解決我的問題。 我不介意我是否必須使用VBA。

Answer 1

在單元格A7使用此公式。 使用CTRL + SHIFT + ENTER組合輸入，然后在表格下方拖動。

=IFERROR(INDEX($A$1:$F$2,2,SMALL(IF((A$6=$A$1:$F$1), COLUMN($A$1:$F$1)-MIN(COLUMN($A$1:$F$1))+1, ""),ROWS($A$1:A1))),"")

Answer 2

以下是我使用詞典設法做的事情。 我使用以下附加功能：

這個循環遍歷第一行中的值，並將唯一的值作為數組返回。 它將是列表的“標題”：

Public Function getUniqueElementsFromArray(elementsInput As Variant) As Variant

    Dim returnArray     As Variant
    Dim element         As Variant
    Dim tempDict        As Object
    Dim cnt             As Long

    Set tempDict = CreateObject("Scripting.Dictionary")

    For Each element In elementsInput
        tempDict(element) = 1
    Next element

    ReDim returnArray(tempDict.Count - 1)
    For cnt = 0 To tempDict.Count - 1
        returnArray(cnt) = tempDict.Keys()(cnt)
    Next cnt

    getUniqueElementsFromArray = returnArray

End Function

這個獲取給定列的lastRow：

Function lastRow(Optional strSheet As String, Optional colToCheck As Long = 1) As Long

    Dim shSheet  As Worksheet

    If strSheet = vbNullString Then
        Set shSheet = ActiveSheet
    Else
        Set shSheet = Worksheets(strSheet)
    End If

    lastRow = shSheet.Cells(shSheet.Rows.Count, colToCheck).End(xlUp).Row

End Function

這個采用單行范圍並返回1D數組：

Public Function getArrayFromHorizontRange(rngRange As Range) As Variant

    With Application
        getArrayFromHorizontRange = .Transpose(.Transpose(rngRange))
    End With

End Function

這是主要的“引擎”：

Option Explicit

Public Sub TestMe()

    Dim keyValues       As Variant
    Dim keyElement      As Variant
    Dim keyElementCell  As Range
    Dim inputRange      As Range
    Dim outputRange     As Range
    Dim outputRangeRow  As Range
    Dim colNeeded       As Long

    Set inputRange = Range("A1:K2")
    Set outputRange = Range("A10")
    Set outputRangeRow = outputRange

    keyValues = getUniqueElementsFromArray(getArrayFromHorizontRange(inputRange.Rows(1)))

    For Each keyElement In keyValues
        Set outputRangeRow = Union(outputRangeRow, outputRange)
        outputRange.value = keyElement
        Set outputRange = outputRange.Offset(0, 1)
    Next keyElement

    For Each keyElementCell In inputRange.Rows(2).Cells
        colNeeded = WorksheetFunction.match(keyElementCell.Offset(-1), outputRangeRow, 0)
        Set outputRange = Cells(lastRow(colToCheck:=colNeeded) + 1, colNeeded)
        outputRange.value = keyElementCell
    Next keyElementCell

End Sub

這是輸入和輸出：