Sub m()
Application.DisplayAlerts = False '避免合并单元格时出现提示
For i = Range("A65536").End(3).Row To 2 Step -1 '从最后一行到倒数第二行循环
If Cells(i, "A") = Cells(i - 1, "A") Then '如果上下两个单元格值相同
Range("A" & i - 1 & ":A" & i).Merge '那么就合并这两个单元格
End If
Next i
Application.DisplayAlerts = True
Application.DisplayAlerts = False '避免合并单元格时出现提示
For i = Range("A65536").End(3).Row To 2 Step -1 '从最后一行到倒数第二行循环
If Cells(i, "A") = Cells(i - 1, "A") Then '如果上下两个单元格值相同
Range("A" & i - 1 & ":A" & i).Merge '那么就合并这两个单元格
End If
Next i
Application.DisplayAlerts = True
End Sub
第二种方式
自己留作参考
Sub test()
Dim str
Dim i, j
i = 1
j = 1
For r = 1 To Worksheets(2).UsedRange.Rows.Count
For c = 1 To Worksheets(2).UsedRange.Columns.Count
str = Worksheets(2).Cells(r, c).Value
Worksheets(3).Cells(j, 1).Value = i
Worksheets(3).Cells(j, 2).Value = c
Worksheets(3).Cells(j, 3).Value = str
j = j + 1
Next
i = i + 1
Next
End Sub
删除形状
Sub test()
Dim sheet As Worksheet
Dim s As Shape
Dim i As Integer
For Each sheet In ActiveWorkbook.Sheets
For Each s In sheet.Shapes
s.Delete
i = i + 1
Next
Next
MsgBox "已删除当前表中 " & i & " 形状"
End Sub
激活当前已使用区域
ActiveSheet.UsedRange.Select