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

以下是我使用词典设法做的事情。我正在使用以下附加功能：

这个循环遍历第一行中的值，并将唯一的值作为数组返回。这将是＆＃34;标题＆＃34;列表：

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

这是主要的＆＃34;引擎＆＃34;：

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

这是输入和输出：

基于excel中第一行值的单元格行到列的范围

2 个答案: