2

我有以下数据网格:

         ---------Header 1   Header 2   Header 3   Header 4 


Row 1       x                    x          x
Row 2                  x         x
Row 3                            x          
Row 4       x          x         x          x

然后我有第二张看起来像这样的表:

Row 1         Row 2        Row 3        Row 4

我希望第二张纸最终看起来像这样:

    Row 1         Row 2        Row 3        Row 4
  Header 1      Header 2     Header 3     Header 1
  Header 3      Header 3                  Header 2
  Header 4                                Header 3
 .                                       Header 4                                        

忽略最后一段,我只是用它来正确格式化它。

我已经用 MATCH 和 INDEX 玩了几个小时,虽然我可以得到它的一部分,但我似乎无法让它们一起工作。

编辑:

我仅使用“Header 1”和“Row 1”作为示例。实际数据分别是 A 列和第 1 行中的文本。另外,由于源数据将被修改,我希望有一些可以自动更新第二张表的东西。

4

3 回答 3

0

它必须使用工作表功能吗?创建一个宏来做会更简单(我做了一个例子)

编辑函数以使用 col a 中的行标题和第 1 行中的列标题,并将其更改为从“源”表读取并将结果写入“输出”表

Public Sub Example()
Dim Output As Worksheet
Dim Sheet As Worksheet
Dim Row As Integer
Dim Column As Integer
    Set Sheet = ThisWorkbook.Worksheets("Source")
    Set Output = ThisWorkbook.Worksheets("Output")
    Output.Cells.Clear ' Since were going to rebuild the whole thing, just nuke it.
    For Row = Sheet.UsedRange.Rows(Sheet.UsedRange.Rows.Count).Row To 2 Step -1
        Output.Cells(1, Row - 1).Value = Sheet.Cells(Row, 1).Value
        For Column = Sheet.UsedRange.Columns(Sheet.UsedRange.Columns.Count).Column To 1 Step -1
            If Not IsEmpty(Sheet.Cells(Row, Column)) Then
                Sheet.Cells(1, Column).Copy
                Output.Cells(2, Row - 1).Insert xlShiftDown
            End If
        Next Column
    Next Row
End Sub

我看了看用工作表函数来做这件事,正如其他人所说,如果没有混合一些 vba,这样做会非常棘手。

如果将此添加到新模块,则可以将其作为工作簿功能进行访问。(并不是说这是最好的方法,只是想尝试一下)

'Return The Column Header of the Nth Non-Blank Cell on Specified Row
Public Function NonBlankByIndex(ByVal Row As Integer, ByVal Index As Integer) As Range
Dim Sheet As Worksheet
Dim Column As Integer
Dim Result As Range
    Set Sheet = ThisWorkbook.Worksheets("Source") ' Change to your source sheet's name
    Set Result = Nothing
    Column = 2 ' Skip 1 as its the header
    Do
        If Column > Sheet.UsedRange.Columns(Sheet.UsedRange.Columns.Count).Column Then
            Exit Do
        End If
        If Sheet.Cells(Row, Column) = "" Then
            Column = Column + 1
        Else
            If Index = 1 Then
                Set Result = Sheet.Cells(1, Column)
                Exit Do
            Else
                Column = Column + 1
                Index = Index - 1
            End If
        End If
    Loop
    Set NonBlankByIndex = Result
End Function
于 2012-07-12T20:16:27.570 回答
0

这是使用 VBA 函数的一种方法:

在开发人员选项卡(*)中单击 Visual Basic,然后单击那里的“插入”菜单并选择“模块”以插入新模块。然后粘贴以下代码:

Option Explicit

Public Function GetHeaderMatchingRow(RowText As String, _
                                    SearchRange As Range, _
                                    iHdrNo As Integer) As String
    Dim rng As Range
    Set rng = SearchRange

    Dim cel As Range

    'Get the Row to scan
    Dim i As Long, rowOff As Long
    For i = 2 To rng.Rows.Count
        Set cel = rng.Cells(i, 1)
        If cel.Value = RowText Then
            rowOff = i
            Exit For
        End If
    Next i

    'Now, scan horizontally for the iHdrNo'th non-blank cell
    Dim cnt As Integer
    For i = 2 To rng.Columns.Count
        Set cel = rng.Cells(rowOff, i)
        If Not CStr(cel.Value) = "" Then
            cnt = cnt + 1
            If cnt = iHdrNo Then
                GetHeaderMatchingRow = rng.Cells(1, i).Value
                Exit Function
            End If
        End If
    Next i

    GetHeaderMatchingRow = ""
End Function

单击“调试”菜单并选择“编译 VBAProject”。

现在回到 Excel 并在您的第一个工作表中定义一个命名范围以覆盖网格中的所有数据。行名称应该是该范围的第一列,而标题文本应该是其中的第一行。

现在转到第二张表并在每个输出单元格中输入这样的公式:

=GetHeaderMatchingRow(A$1, RowHeaderRange, 1)

其中第一个参数是它将尝试在范围的第一列中匹配的行文本。我在这里有“A$1”,因为在我的测试中,我的第二张表的列标题也是我第一张表中的行名,就像你的一样。

第二个参数是要搜索的范围(在这种情况下,我们之前定义的命名范围),第三个参数是它正在寻找的匹配的计数(第一个、第二个、第三个等)。

请注意,第一个和第三个参数应根据输出的列和行而改变。

于 2012-07-12T21:24:00.393 回答
0

If you are happy with blanks in the listing try this in sheet2!A2:

=IF(INDEX(Sheet1!$B$2:$E$5,MATCH(A$1,Sheet1!$A$2:$A$5,0),ROW()-1)="x",INDEX(Sheet1!$B$1:$E$1,1,ROW()-1),"")

Just copy the formula over range A2:D5

于 2012-08-05T12:22:02.890 回答