MS Excel的 – 寻找合并单元格，并在他们的信息在相应的行

A列中有一些合并的和一些未合并的单元格，大小不同，B列是由所有未合并单元格组成的。

我正在查找一个公式（如果不存在，可以用VBA编写），它将确定一个单元格是合并还是未合并到A中，如果合并，则合并列B中的组件（如公式连接）并将其写入其中的一行，比如上面的一行，如果可能的话删除下面的行。

我可以用一个公式来做这个，任何人都可以用给定的代码来帮助我吗？

---

现在我想不丢失给定行的数据，但是在它们之间的第3和第4列中添加数据，如图所示。 如果可能的话，让星星消失。

Answer 1

为了使它快速简单：（把它放在VBA窗口中的任何模块中）

Option Explicit Public Function merge_merged(rng As Range) As Variant Dim i As Long, j As Long, output() As Variant ReDim output(1 To UBound(rng.Value), 1 To 2) For j = 1 To UBound(rng.Value) If Len(rng(j, 1).Text) Then i = i + 1 output(i, 1) = rng(j, 1).Text output(i, 2) = rng(j, 2).Text Else output(i, 2) = output(i, 2) & ", " & rng(j, 2).Text End If Next For i = i + 1 To j - 1 output(i, 1) = "" output(i, 2) = "" Next merge_merged = output End Function 

然后select范围D2：E13并使用公式

 =merge_merged(B2:C13) 

这是一个数组公式，必须用Ctrl + Shift + Enter 键 确认 。

应该按照你的要求去做…如果你还有什么问题，只需写评论

也适用于我的string：

编辑 ：

在得到你想要的答案之后，你不应该改变问题，更好的问一个新问题。 不过，这次我会提供一个解决scheme：

 Option Explicit Public Function merge_merged(rngIn As Range) As Variant Dim i As Long, j As Long, k As Long, output() As Variant, rng As Variant rng = rngIn.Value ReDim output(1 To UBound(rng), 1 To UBound(rng, 2)) For j = 1 To UBound(rng) If Len(rng(j, 1)) Then i = i + 1 For k = 1 To UBound(output, 2) If IsNumeric(Replace(rng(j, k), "*", "")) Then output(i, k) = Replace(rng(j, k), "*", "") Else output(i, k) = rng(j, k) End If Next Else For k = 1 To UBound(output, 2) If Len(rng(j, k)) Then If IsNumeric(output(i, k)) And IsNumeric(Replace(rng(j, k), "*", "")) Then output(i, k) = 0 + output(i, k) + Replace(rng(j, k), "*", "") Else output(i, k) = output(i, k) & ", " & rng(j, k) End If End If Next End If Next For i = i + 1 To j - 1 For k = 1 To UBound(output, 2) output(i, k) = "" Next Next merge_merged = output End Function 

• 只有第一列将被检查崩溃
• 如果列“2”到“结束”包含数字，他们将被总结
  • 具有混合的值（数字和string）可能会搞砸
    • “A”，“3”，“5”将是“A，3，5”
    • “3”，“A”，“5”将是“3，A，5”
    • 但是“3”，“5”，“A”将是“8，A”
  • *如果string是数字没有它将被删除
• 它将拉第一行的所有值（对于每个合并的部分）
  • 如果没有“第一个”值，则第一个find的值将显示为“，value”
  • 如果所有的单元格都是空的，输出也将是空的
• 空单元格将被忽略（“A”，“”，“C”将变成“A，C”）
• 将variables中的所有内容都推送到更大的表中

Answer 2

而不是处理Range.MergeArea属性 ，最好是简单地使用Range.UnMerge方法处理违规的单元格，然后用不同的方式处理生成的空白。

 Sub flatten_merge() Dim rw As Long, v As Long, vVALs As Variant With Worksheets("Sheet1") .Columns(1).UnMerge ReDim vVALs(1 To Application.Count(.Columns(1)), 1 To 2) For rw = 1 To .Cells(Rows.Count, "B").End(xlUp).Row If IsEmpty(.Cells(rw, 1)) Then vVALs(v, 2) = vVALs(v, 2) & Chr(44) & .Cells(rw, 2).Value2 Else v = v + 1 vVALs(v, 1) = .Cells(rw, 1).Value2 vVALs(v, 2) = .Cells(rw, 2).Value2 End If Next rw .Cells(1, 1).Resize(1, 2).EntireColumn.Clear .Cells(1, 1).Resize(UBound(vVALs, 1), UBound(vVALs, 2)) = vVALs End With End Sub 

如果您需要保留原始内容，则只需将源代码复制到新位置即可。

样本数据和结果：

^之前之前

Answer 3

已发布的其他变体：

 Sub tets() Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary") Dim cl As Range, Data As Range, k, s% Dic.comparemode = vbTextCompare Set Data = Range("A1:A" & [A:A].Find("*", , , , xlByRows, xlPrevious).Row) For Each cl In Data If cl.Value2 <> "" Then s = cl.Value2 If Not Dic.exists(s) Then Dic.Add s, cl.Offset(, 1).Value2 Else Dic(s) = Dic(s) & "," & cl.Offset(, 1).Value2 End If Next cl For Each k In Dic Debug.Print k, Dic(k) Next k End Sub 

testing

Answer 4

我想首先“取消合并”单元格，然后使用集合来获取唯一的值并创build一个循环。

  Sub uNMERGE() Dim rng As Range, lstRw As Long, c As Range Columns("A:A").MergeCells = 0 lstRw = Cells(Rows.Count, "A").End(xlUp).Row Set rng = Range("A1:A" & lstRw) For Each c In rng.Cells If c = "" Then c = c.Offset(-1) End If Next c UsingColection End Sub Sub UsingColection() Dim cUnique As Collection Dim rng As Range, c As Range Dim Cell As Range Dim sh As Worksheet Dim vNum As Variant Dim rws As Long, s As String Set sh = ThisWorkbook.Sheets("Sheet1") rws = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row Set rng = sh.Range("A1:A" & rws) Set cUnique = New Collection On Error Resume Next For Each Cell In rng.Cells cUnique.Add Cell.Value, CStr(Cell.Value) Next Cell On Error GoTo 0 For Each vNum In cUnique Cells(Rows.Count, "D").End(xlUp).Offset(1, 0) = vNum For Each c In rng.Cells If c = vNum Then s = s & c.Offset(, 1) & "," End If Next c Cells(Rows.Count, "D").End(xlUp).Offset(0, 1) = Mid(s, 1, Len(s) - 1) s = "" Next vNum End Sub 

之前

后

Answer 5

那么这个代码有什么问题呢？ – 因为它提供了#VALUE！ 每个单元格select错误。

 Option Explicit Public Function merge_merged(rng As Range) As Variant Dim i As Long, j As Long, output() As Variant ReDim output(1 To UBound(rng.Value), 1 To 4) For j = 1 To UBound(rng.Value) If Len(rng(j, 1).Text) Then i = i + 1 output(i, 1) = rng(j, 1).Text output(i, 2) = rng(j, 2).Text output(i, 3) = rng(j, 3).Value output(i, 4) = rng(j, 4).Value output(i, 5) = rng(j, 5).Text Else output(i, 2) = output(i, 2) & ", " & rng(j, 2).Text output(i, 3) = output(i, 3) + rng(j, 3).Value output(i, 4) = output(i, 4) + rng(j, 4).Value output(i, 5) = rng(j, 5).Text End If Next For i = i To j - 1 output(i, 1) = "" output(i, 2) = "" output(i, 3) = "" output(i, 4) = "" output(i, 5) = "" Next merge_merged = output End Function Sub ece() End Sub 

还有什么可以做的search“明星”？ 如果每个单元格中的数据（即使合并了一次）都有“星号”，则创build一个新列以供参考。