在一个表中匹配/重新排列 2 组 IDS答案

【问题标题】：Match/Rearrange 2 sets of IDS in one table在一个表中匹配/重新排列 2 组 IDS
【发布时间】：2018-09-01 12:51:11
【问题描述】：

我有一个包含 4 个 ID 字段（ID_1、ID_2、ID_3、ID_4）的 csv 文件。这 4 个字段的组合在文件中是唯一的。问题是我正在尝试创建与 4 个中的任何一个相关联的所有 ID 的广泛列表，并且在其他行中存在具有附加 ID 或空白的匹配项。我想创建一个数据集，在这些 ID 字段中查找匹配项，并为每个额外的唯一值添加一列，以创建关联 ID 的完整列表。合并应删除任何 ID 的重复。

【问题讨论】：

提供一个示例，显示填写了示例数据的字段和所需的结果
如果没有更多信息很难提供帮助，请给我们一些数据，但我猜 CTE 会为您完成。
好的，这个例子和想要的结果有意义吗？

标签： sql excel vba csv

【解决方案1】：

我相信您的目标是合并任何有 ID 匹配的行中的项目。我想出了一些代码来解决这个问题，但意识到这可能不是最好的方法，所以我停止了追求。就目前而言，它假设 ID 行从工作表的左上角开始，并且代码仅将那些重复的 ID 涂成红色。我在整个代码中放置了.select 语句，这样您就可以单步执行它并查看它是如何工作的。

但是，如果您想继续，您可以添加代码以在这些单元格显示为红色的位置合并行。如果这样做，请删除所有 .select 语句。

Option Explicit
Sub repeatedIDs()
Dim r As Range, cell As Range, remainingRows As Range
Dim lastRow As Range, i As Integer, j As Integer
Set r = Range("A2")
Set r = Range(r, r.End(xlDown).Offset(0, 3))
r.Select
Set lastRow = r.Rows(r.Rows.Count)
lastRow.Select
For i = 1 To r.Rows.Count - 1
  Set remainingRows = Range(r(i + 1, 1), r(r.Rows.Count, 4))
  remainingRows.Select
  For j = 1 To 4
    For Each cell In remainingRows
      cell.Select
      If cell = r(i, j) And cell <> "" And r(i, j) <> "" Then

        '*****   color cells with same ID red  *****
        cell.Font.Color = vbRed
        r(i, j).Font.Color = vbRed

      End If
    Next cell
  Next j
Next i
End Sub

【讨论】：