☰

将多个值合并到带空白的行中

tag-icon • tag-icon microsoft-excel vba microsoft-excel-2013
将多个值合并到带空白的行中

所以我研究了一段时间，但似乎遇到了瓶颈。我承认——我成功做过一次，为我的同事做了一个教程——然后我和其他人都无法复制结果。我对 Excel 有点了解——但 VBA 和一般的编码我还很陌生（所以如果我遗漏了一些显而易见的东西，我深表歉意）。

我使用了这个问题中的 VBA 代码，如何在 Excel 中将多行的值合并为一行？

Sub CombineRowsRevisited()

Dim c As Range
Dim i As Integer

For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))
If c = c.Offset(1) And c.Offset(,4) = c.Offset(1,4) Then
        c.Offset(,3) = c.Offset(1,3)
        c.Offset(1).EntireRow.Delete
End If

Next

End Sub

这种方法成功了一次。一个小时后，我又试了一次，当我运行相同的代码时，什么也没发生。我按下运行按钮，一切看起来都一样。

我很绝望，尝试了前面提到的问题中的其他代码，但它不适用于我的数据设置方式/原作者无论如何更喜欢初始公式。

以下是我正在处理的数据示例。有人有什么建议或发现我这方面存在任何明显错误吗？

在此处输入图片描述

此外，我并不担心非课程 ID 中的数据被覆盖。

答案1

我将使用 Power Query 插件来满足此要求。查询可以从现有的 Excel 表开始。我将使用 Group By 命令来定义所需的“组合”逻辑。

http://office.microsoft.com/en-au/excel-help/group-rows-in-a-table-HA103993875.aspx?CTT=5&origin=HA103993930

我会将结果传送到 Excel 表中。

答案2

我相信这会满足您的要求。它几乎与原始版本相同，但我添加了一些细节，使其更易于理解和修改。

Sub CombineRowsRevisited()

    Dim c As Range
    Dim i As Integer
    Dim PersonID, REAScore, WRTScore, startDate, courseID as integer

    'Columns as I understand them (subtracting one from the actual column in the sheet)
    PersonID = 0    'personid is in column 1  etc..
    '...
    startDate = 1
    courseID = 2
    REAScore = 3    
    WRTScore = 4
    ESSScore = 5


    'Looping through each record
    For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))

      'If personID on this record is the same as the personID on the next record
      If c.Offset(0, PersonID ) = c.Offset(1, PersonID ) Then

            'blindly overwrite startDate and courseID with the value from the next row
            c.offset(1, startDate ) = c.Offset(0, startDate)
            c.offset(1, courseID) = c.offset(0, courseID)

            'only copy the scores if they are not null
            if c.offset(0, REAScore).value <> vbNull then c.offset(1, REAScore) = c.offset(0, REAScore)
            if c.offset(0, WRTScore).value <> vbNull then c.offset(1, WRTScore) = c.offset(0, WRTScore)
            if c.offset(0, ESSScore).value <> vbNull then c.offset(1, ESSScore) = c.offset(0, ESSScore)

            'Just added this to delete the next row when a match is found
            c.entireRow.Delete
      End If
    Next

End Sub

相关内容