Sub Macro1() Application .ScreenUpdating = False Application .DisplayAlerts = False '屏蔽合并警告 Dim rng As Range Set rng = Cells(1 , 1 ) '从A1开始 For i = 1 To Range("a65536" ).End (xlUp).Row + 1 If Trim (Cells(i, 1 )) = "" Then '增加对空格的判断 Set rng = Union(rng, Cells(i, 1 )) Else rng.Merge: Set rng = Cells(i, 1 ) End If Next i Application .ScreenUpdating = True Application .DisplayAlerts = True End Sub
1、判断单元格是否包含在合并单元格中。MergeCells属性可以用来判断单元格是否包含在合并单元格中,如A1:B2合并为一个合并单元格,那么:Range("A1").MergeCells就会返回True!
2、获得包含指定单元格的合并区域。MergeArea属性可以获得包含指定单元格的合并区域,如:A1:B2合并为一个合并单元格,那么:Range("A1").MergeArea.Address就会返回$A$1:$B$2。
3、合并复制。在合并单元格时,我们经常会遇到合并的单元格区域中,有多个单元格有内容,而合并单元格时会提示,只能保留最左上角的数据,如果我们想让合并区域的内容在合并后把所有的内容也合并在合并单元格中,就可以使用这个自定义宏来完成
Sub 生成2() Dim c As Range, r As Range, i As Integer, x, n As New Collection, Str As String With Sheet2 .Range(.[A2], .[C2].End(xlDown)).ClearContents Set c = [A2] Set r = .[A2] End With Do While c <> "" x = Split(c.Offset(0, 2), "/") '拆分C列数据 For i = 0 To UBound(x) If x(i) <> "" Then On Error Resume Next n.Add x(i), CStr(x(i)) On Error GoTo 0 End If Next If c <> c.Offset(1, 0) Then '比较当前单元格与下一单元格 For i = 1 To n.Count Str = Str & IIf(Str = "", "", "、") & n.Item(1) '取第一个,取完移除 n.Remove (1) Next r = c ' 赋值 r.Offset(0, 1) = c.Offset(0, 1) r.Offset(0, 2) = Str Str = "" Set r = r.Offset(1, 0) '设置成下一单元格 End If Set c = c.Offset(1, 0) '设置成下一单元格 Loop End Sub
填充空白单元格
Range("P7:P13").Select Selection.SpecialCells(xlCellTypeBlanks).Select Selection.FormulaR1C1 = "=R[-1]C"