合并具有相同标题的包含拆分数据的列

Posted 2023-02-23

【中文标题】合并具有相同标题的包含拆分数据的列

【英文标题】：Merge columns with same header containing split data

【发布时间】：2015-12-06 19:35:14

【问题描述】：

我有一个 Excel 文件，其中第 2 行包含标题。其中一些标题是“克隆的”，并且数据在两个克隆之间划分（在下面的链接文件中，例如列 Q 和 T 以及 AK 和 AQ）。在 Q 列中有一些空单元格，T 包含要放入这些空单元格的数据。

请参阅以下文件以获取示例： https://dl.dropboxusercontent.com/u/18908464/Example.xlsx

我一直在寻找一种代码，用于在第 2 行中搜索具有相同标题的列，然后将它们合并到没有空单元格的一列中，如果可能的话，在合并后删除空列。

使用 Excel 2013。

【问题讨论】：

你有两个以上的事情要做吗？如果没有，我只能手动完成。这将是最有效的。或者这是你半定期做的事情？

这将是半定期完成的事情，所以如果可能的话，我正在考虑自动化它。

【参考方案1】：

此代码将合并所有具有重复标题的列

如果 Q 中的单元格为空，它会将重复列 (T) 中的数据带到其左侧的第一列 (Q)

将其粘贴到标准 VBA 模块中，然后在 VBA 中添加引用：

导航到工具 > 参考 向下滚动并选择

Microsoft 脚本运行时

单击代码中的任意位置并按 F5 运行它（在文件副本上）

---

Option Explicit

Public Sub mergeColumns()
   Const HDR As Long = 7      'header row
   Const HDC As Long = 2      '(first) header column

   Dim ws As Worksheet, lRow As Long, lCol As Long, hRow As Variant, i As Long
   Dim ac As New Dictionary, dc As New Dictionary, c1 As Variant, c2 As Variant
   Dim itm As Variant, dCols As Range, d As Range, tr As String
   Set ws = ThisWorkbook.Worksheets("Ark1")
   lRow = ws.Cells(ws.Rows.Count, HDC).End(xlUp).Row
   lCol = ws.Cells(HDR, ws.Columns.Count).End(xlToLeft).Column
   If lRow > HDR And lCol > HDC Then
      hRow = ws.Range(ws.Cells(HDR, HDC), ws.Cells(HDR, lCol)).Value2
      For i = 1 To lCol - HDC + 1 'find dupes ---------------------------------------------
         tr = Trim(hRow(1, i))
         If Len(tr) > 0 Then
            If ac.Exists(tr) Then dc.Add ac(tr), i + HDC - 1 Else ac.Add tr, i + HDC - 1
         End If
      Next
      Application.ScreenUpdating = False
      For Each itm In dc 'merge columns ---------------------------------------------------
         c1 = ws.Range(ws.Cells(HDR, itm), ws.Cells(lRow, itm)).Value2
         c2 = ws.Range(ws.Cells(HDR, dc(itm)), ws.Cells(lRow, dc(itm))).Value2
         For i = 1 To lRow - HDR + 1
            If Len(Trim(c1(i, 1))) = 0 Then c1(i, 1) = c2(i, 1) 'trimms blanks
         Next
         ws.Range(ws.Cells(HDR, itm), ws.Cells(lRow, itm)).Value2 = c1
      Next
      For Each itm In dc 'delete duplicate columns ----------------------------------------
         Set d = ws.Cells(HDR, dc(itm))
         If dCols Is Nothing Then Set dCols = d Else Set dCols = Union(dCols, d)
      Next
      If Not dCols Is Nothing Then dCols.EntireColumn.Delete
      Application.ScreenUpdating = True
   End If
End Sub

---

测试了大约 100 万条记录（总行数：994,503 行：3.9453125 秒）

---

编辑：

我进行了一项调整，以处理看似空白但实际上包含空格的字段

一些“空白”您的新文件包含 7 个空格（转换为 7 个字符，因此不是空白）

示例：单元格 H54、55、56 等

我包含了一个 Trim() 函数，用于删除所有空格（制表符、回车等）

除了我调整的以外：

Const HDR As Long =

7

Const HDC As Long =

2

和

Set ws = ThisWorkbook.Worksheets("

Ark1

")

前后的新文件：

【讨论】：

谢谢保罗。这就像一个魅力！作为“编辑和导入”过程的一部分，我从不同的文件运行它，因此不得不做一些小的编辑。

不客气 - 我很高兴它有帮助。 3 个主要调整是针对 HDR（标题行）、HDC（第一个数据列）和 Set ws = ThisWorkbook.Worksheets("Krysstabell") 使用您必须在其上运行的任何工作表

嘿@paulbica，再次感谢您提供的帮助。我有一个与您在上面解决的案例类似的案例，并且想知道是否可以对上面的代码进行更改以使其适用于我在这里上传的文件：[链接]dropbox.com/s/3rkl7b60lyg3otm/test.xls?dl=0 注意有重复的数字复制列中的“tørrstoff (E)”，其中第二列中的第二个数字可以删除。

我对新文件进行了测试（并稍作调整）；有关详细信息，请参阅可能的编辑

干杯 @paulbica 我已经测试过了，它适用于我上传的文件，但我看到你已经将标题行设置为 7，而它应该是 6，因为这是标题。重复的列被命名为“11, 0-3-1m Jord”和“11, 0-3-1m. Jord”。其中副本包含“。”其中，重复列中的第一个数字 83,7（在这种情况下）也是重复的。是否可以编辑您的代码以使其工作，以便标题行为 6，它在其中搜索包含“。”的重复标题。并且重复列中的第一个数字（如果有）应该被删除，并且列合并和空删除像以前一样。感觉？