根据excel中的第一行值,列的单元格行的范围

我有一些excel中的单元格

AAABBB A1 A2 A3 B1 B2 B3 

有没有任何想法如何将这个单元格的范围转换成 –

 AB A1 B1 A2 B2 A3 B3 

我试图用Excel中的Kutools插件,但它不能解决我的问题。 我不介意我是否必须为此使用VBA。

在单元格A7使用此公式。 用CTRL + SHIFT + ENTER组合键input,然后拖动到表格下方。

 =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))),"") 

在这里输入图像说明

这是我设法做的,用字典。 我正在使用以下附加function:

这个循环遍历第一行的值,并返回唯一的数组。 这将是名单的“标题”:

 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 

这一个需要一个单一的行范围,并返回一维数组:

 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 

这是input和输出: 在这里输入图像描述