如何在数据中填入具体的头部和编号？

Question

我在一列中有一组数据，其中3行属于一种类型，接下来3行属于另一种类型(这取决于标题)标题是文章、期刊、Doi我想要形成一个表，使用标题条件:应该每3行检查一次，如果一个标题丢失，我希望结果为NULL并移动到下一行。我想按顺序来做

Article      _   Cyclopia Extracts

Journal      _   Planta Medica
DOI          _   10.1055/s-0043-121270
Article      _   Germline Mutations
Journal      _   Human Molecular Genetics
DOI          _   10.1093/hmg/4.12.2233
Article      _   Critical Speed
Journal      _   Vehicle System Dynamics
Article      _   Recycling and Neutral
Journal      _   Journal of Nuclear Materials
DOI          _   10.1016/0022-3115(89)90259-6


Article      _   Cyclopia Extracts  Journal      _   Planta Medica  DOI          _   10.1055/s-0043-121270
Article      _   Germline Mutations Journal      _   Human Molecular Genetics   DOI          _   10.1093/hmg/4.12.2233
Article      _   Critical Speed and Journal      _   Vehicle System Dynamics    Null
Article      _   Recycling and  Journal      _   Journal of Nuclear Materials   DOI          _   10.1016/0022-3115(89)90259-6

Answer 1

我会使用power query来做这件事。你所说的那种转换是一个“Pivot.‘”

因此，您已经将数据放在两列中

​

​

您希望添加一些内容，以帮助Excel了解哪些行合并为一条记录。您可以添加一个小公式来完成此操作。

=IFERROR(IF(B2="Article",A1+1,A1),1)

我将其放入A2中，然后将其复制到整个表的列中。它基本上是记数的。每当标题是“文章”时，计数就会增加。

​

​

选择整个表格。导航到Data选项卡并单击'From Table/Range‘

​

​

这将打开Power Query编辑器。突出显示标题列，导航到Transform选项卡，然后单击“Any column”组下的“Pivot”。在弹出的对话框中，将Values列设置为您的'information‘列，然后展开"Advanced Options“。将聚合值函数设置为最小值(或最大值，两者均适用)。

​

​

点击OK，然后返回到“Home”标签，选择“close and load”。

​

​

太好了！

​

希望能有所帮助。

Answer 2

Option Explicit

' https://stackoverflow.com/questions/57116717/how-to-fill-data-with-specific-header-and-number

Private Range_Headers As Range
Private Range_Data As Range
Private Separ As String

Sub Run_()

    Set Range_Data = Range("$A$1:$A$11")
    Set Range_Headers = Range("$F$1:$H$1")
    Separ = " _ "

    Data_ForEach Range_Data

End Sub

Sub Data_ForEach( _
    r As Range)

    Dim ceLL As Range

    For Each ceLL In r

        With ceLL

            PutIn_Column ceLL.Value

        End With
    Next
End Sub

Sub PutIn_Column( _
    s As String)


    Dim sHead As String, sValu As String

    If InStr(s, Separ) > 0 Then

        sHead = Trim(Split(s, Separ)(0))
        sValu = Trim(Split(s, Separ)(1))

        Inter_Sect _
                Row_Esta(sHead), Column_Esta(sHead), sValu

    End If
End Sub

Function Row_Esta( _
         s As String) _
         As Long

With Range_Headers(1, 1)
    If s = .Value Then
        ' HeadKey
        If .Offset(1, 0).Value = vbNullString Then

            Row_Esta = .Row + 1

        Else
            Row_Esta = .End(xlDown).Row + 1

        End If

    Else

        Row_Esta = .End(xlDown).Row

    End If
End With
End Function

Function Column_Esta( _
         s As String) _
         As Long
'
    Dim r As Range

    Set r = Range_Headers.Find(s)

    If Not r Is Nothing Then

        Column_Esta = r.Column

    End If
End Function

Function Inter_Sect( _
         lRow As Long, _
         lCol As Long, _
         s As String) _
         As String
'
    If lRow * lCol > 0 Then

        Cells(lRow, lCol).Value = s

    End If
End Function