如何用特定的标题和编号填充数据?

时间:2019-07-19 16:53:45

标签: excel vba

我在一列中有一组数据,其中3行属于一种类型,而后3行属于另一种类型(取决于标题)。标题为Article,Journal,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

2 个答案:

答案 0 :(得分:0)

我将使用功率查询来执行此操作。您正在谈论的转换类型是“枢轴”。

因此,您的数据分为两列

enter image description here

您要添加一些内容,以帮助Excel了解哪些行合并形成一条记录。您可以添加一些公式来执行此操作。

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

我将其放在A2中,然后将其复制到整个表的列中。它基本上保持计数。每次标题为“文章”时,计数都会增加。

enter image description here

选择整个表格。导航到“数据”标签,然后单击“从表/范围”

enter image description here

这将打开Power Query编辑器。突出显示标题列,导航到“转换”选项卡,然后单击“任何列”组下的“枢轴”。在弹出的对话框中,将“值”列设置为“信息”列,然后展开“高级选项”。将“汇总值函数”设置为“最小值”(或最大值,可以使用)。

enter image description here

点击“确定”,然后返回“首页”标签并选择“关闭并加载”。

enter image description here

Presto!

enter image description here 希望对您有所帮助。

答案 1 :(得分:0)

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