[英]Excel VBA - Row with merged cells, code for unmerging and Concatenating data
Hi - I have been stuck on some VBA - I have extracted some data which is displayed in columns - the problem is some of the data in column 3 has been put into 2 cells - meaning all the corresponding cells in those 2 rows have been merged.嗨-我一直卡在一些 VBA 上-我提取了一些显示在列中的数据-问题是第 3 列中的一些数据已放入 2 个单元格中-这意味着这 2 行中的所有相应单元格都已合并. A way round this which I have done using VBA is to split any merged cells within the same row and duplicate their contents in the new unmerged cells - this essentially has created a lot of duplicate data - so dont really want to do this我使用 VBA 完成的一种方法是拆分同一行中的任何合并单元格并将其内容复制到新的未合并单元格中 - 这实际上创建了很多重复数据 - 所以真的不想这样做
I am not sure if anyone has got any ideas on the best solution for this.我不确定是否有人对此的最佳解决方案有任何想法。 All i really want to do is concatenate Column 3A data with column 3B data -so putting them in the same cell and removing the merged cells- but this can be dynamic and not every row in this column may be split like this See below:我真正想要做的就是将第 3A 列数据与第 3B 列数据连接起来——因此将它们放在同一个单元格中并删除合并的单元格——但这可以是动态的,并且并非此列中的每一行都可以像这样拆分见下文:
I have used this code: this only removes the merged cells and duplicates the data in the new empty cells from their corresponding cells.我已经使用了这段代码:这只会删除合并的单元格,并从相应的单元格中复制新的空单元格中的数据。
Dim rng As Range, xCell As Range Set WorkRng = recwbk.Worksheets(1).Range("A3:M" & recwbk.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row) Application.ScreenUpdating = False Application.DisplayAlerts = False For Each rng In WorkRng If rng.MergeCells Then With rng.MergeArea.UnMerge.Formula = rng.Formula End With End If Next Application.DisplayAlerts = True Application.ScreenUpdating = True
Sub Tester22()
Dim col As New Collection, maxRows As Long, n As Long
Dim c As Range, c2 As range
'loop over row2 and check for merged cells
For Each c In ActiveSheet.Range("B2:G2").Cells
n = c.MergeArea.Rows.Count
If n > 1 Then
If n > maxRows Then maxRows = n 'tracking max # rows merged
c.UnMerge
Else
col.Add c 'not merged: deal with these later
End If
Next c
'loop over the unmerged cells and pull content from the rows below
For Each c In col
For n = 2 To maxRows
Set c2 = c.Offset(n - 1, 0)
c.Value = c.Value & vbLf & c2.Value
c2.ClearContents
Next n
Next c
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.