☰

Excel - 根据单元格的内容重复行

tag-icon • tag-icon microsoft-excel
Excel - 根据单元格的内容重复行

我有一个包含 600 行的电子表格。每行代表 2 到 12 个地理特征，每个特征都有自己的参考编号或“NGR”。

但我希望每行仅代表一个特征。因此，如果一行中有 3 个特征，我希望该行有 3 个副本，其中仅更改了“NGR”参考编号。

总之我想要的是：

现在怎么样

改为：

我多么想要

请注意行是如何重复的，但 NGR 列保留了唯一的引用。

答案1

您可以使用Power QueryMicrosoft 为 Excel 2010 或更高版本提供的免费插件来执行此操作；并内置到 Excel 2016 / Office 365 中，它Get & Transform 仅被称为您（在 Excel 2016 中；步骤可能与 2010 中的步骤类似）

  • Get&Transform从中选择Table/Range
  • 在 Power Query 编辑器中，选择 NGR 列
    • 按分隔符（逗号）分隔
  • 然后选择拆分列（可能会有三个或更多）
  • 逆透视这些列

使用您的数据的结果：

在此处输入图片描述

  • 删除标有Attribute

  • 将包含 NGR 值的列移回开头并重命名该列。

当您有新数据时，您可以随时重新运行查询来执行相同的操作。

答案2

尝试添加按钮点击控件并分配宏：

    Sub Button1_Click()
    Application.ScreenUpdating = False
    arr = Sheets(1).UsedRange
    a = 2
    For j = 2 To UBound(arr)
        If InStr(arr(j, 1), ",") > 0 Then
            brr = Split(arr(j, 1), ",")
            For i = 0 To UBound(brr)
                Cells(a, 1) = brr(i)
                For k = 2 To 4
                    Cells(a, k) = arr(j, k)
                Next k
                a = a + 1
            Next i
        Else
            For i = 1 To 4
                Cells(a, i) = arr(j, i)
            Next i
            a = a + 1
        End If
    Next j
    Application.ScreenUpdating = True
End Sub

答案3

您可以尝试使用此脚本并运行重复行子

Function getLastCell(pChamp As String)

    Dim LastColonne As Double
    Dim LastLigne As Double
    Dim vCurrentCell

    vCurrentCell = ActiveCell.Address

    ActiveCell.SpecialCells(xlLastCell).Select
    LastColonne = ActiveCell.Column
    LastColonne = LastColonne

    LastLigne = ActiveCell.Row
    LastLigne = LastLigne

    Range(vCurrentCell).Select

    If pChamp = "LINE" Then
        getLastCell = LastLigne
    ElseIf pChamp = "COLUMN" Then
        getLastCell = LastColonne
    Else
        getLastCell = "ERROR : Param LINE / COLUMN"
    End If


End Function

Function CutLine(pLine As Variant, pSeparator As String)
    Dim fields As Variant
    Dim vLine As Variant

    fields = Array()
    i = 0
    pos = 1
    vLine = pLine
    Do While pos <> 0
        pos = InStr(vLine, pSeparator)
        ReDim Preserve fields(i)
        If pos <> 0 Then
            fields(i) = Left(vLine, pos - 1)
            vLine = Mid(vLine, pos + Len(pSeparator))
        Else
            fields(i) = vLine
        End If
        i = i + 1
    Loop

    CutLine = fields
End Function

Function getElement(pString As String, pSeparator As String, pId As Double)

    vTab = CutLine(pString, pSeparator)

    getElement = vTab(pId - 1)
    'getElement = vTab(0)

End Function

Function getNbElement(pString As String, pSeparator As String)

    vTab = CutLine(pString, pSeparator)

    getNbElement = UBound(vTab) + 1

End Function

Function getLastElement(pString As String, pSeparator As String)

    vTab = CutLine(pString, pSeparator)

    getLastElement = vTab(UBound(vTab))

End Function

Function ColumnLetter(ColumnNumber As Double) As String


    If ColumnNumber <= 0 Then
        'negative column number
        ColumnLetter = ""

    ElseIf ColumnNumber > 16384 Then
        'column not supported (too big) in Excel 2007
        ColumnLetter = ""

    ElseIf ColumnNumber > 702 Then
        ' triple letter columns
        ColumnLetter = _
        Chr((Int((ColumnNumber - 1 - 26 - 676) / 676)) Mod 676 + 65) & _
        Chr((Int((ColumnNumber - 1 - 26) / 26) Mod 26) + 65) & _
        Chr(((ColumnNumber - 1) Mod 26) + 65)

    ElseIf ColumnNumber > 26 Then
        ' double letter columns
        ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
                Chr(((ColumnNumber - 1) Mod 26) + 65)
    Else
        ' single letter columns
        ColumnLetter = Chr(ColumnNumber + 64)

    End If

End Function


Sub DuplicateLine()
Dim j As Double


    vMaxLigne = getLastCell("LINE")
    vNewLineId = vMaxLigne + 1
    For i = 2 To vMaxLigne
        vNbSite = Cells(i, 3)
        If vNbSite <> "" Then 'Manage Null Rows

            If vNbSite > 1 Then
                For j = 1 To vNbSite
                    'Copy Original Line
                    Rows(i & ":" & i).Copy
                    'Insert Original Line in New Line
                    Rows(vNewLineId & ":" & vNewLineId).Insert Shift:=xlDown
                    vNgr = getElement(Cells(i, 2), ", ", j)
                    Range("B" & vNewLineId).Value = vNgr

                    vNewLineId = vNewLineId + 1
                Next j
            End If
        End If
    Next i
    'Delete Original Line
    Rows(2 & ":" & vMaxLigne).Delete Shift:=xlUp

End Sub

相关内容