Excel vba开发合并单元格拆分自动填充功能、在每一条数据后面插入空白行、将地理坐标的经纬度转换成度等功能

写在前面:

最近老大丢给我一个数据量比较大，比较复杂的表，让我用VB去处理，刚被分到这个任务的时候一脸茫然，对Excel VB开发一点都不了解，所以就自己研究并查资料，最后终于解决了。

一、Excel VBA拆分合并单元格并自动填充

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim n As Long, i As Long, c As Range
n = ActiveSheet.UsedRange.Count
For i = 1 To n
If ActiveSheet.UsedRange.Item(i).MergeCells = True Then
ActiveSheet.UsedRange.Item(i).Select
Selection.UnMerge
With Selection
.Value = .Cells(1, 1)
End With
Selection.Cells(1, 1).Copy
Selection.PasteSpecial Paste:=xlPasteFormats
End If
Next
End Sub

注意：SelectionChange是一个单元格事件，即当工作表上的选定区域发生改变时，将产生本事件。

二、Excel VBA在每一条数据插入一条空白行

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
LastRow = ActiveSheet.UsedRange.Rows.Count
LastRow = LastRow + ActiveSheet.UsedRange.Rows.Count
Dim i As Integer
For i = 1 To LastRow
ActiveSheet.Rows(i + 2).Insert shift:=xlDown
i = i + 1
Next
End Sub

注意：在每一行后面插入数据就是隔行插入空白行，之后利用Cells(i,j)来对每行进行赋值就可以了，下面就是我这个代码中为空白行赋的值

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
LastRow = ActiveSheet.UsedRange.Rows.Cou
Dim i As Integer
For i = 3 To LastRow
Cells(i, 11) = Cells(i - 1, 15)
Cells(i, 13) = Cells(i - 1, 16)
Cells(i, 14) = Cells(i - 1, 17)
Cells(i, 18) = Cells(i - 1, 18)
Cells(i, 19) = Cells(i - 1, 19)
Cells(i, 20) = Cells(i - 1, 20)
i = i + 1
Next
End Sub

注意：Worksheet_BeforeDoubleClick 为工作表的双击事件，当双击单元格表时就会触发这个事件

三、Excel VBA将地理坐标的经纬度转换成秒等功能

需要注意的是：如果经纬度数据中的度分秒数据中的度分秒是通过插入符号进去的，就需要用拆分函数，如果是设置单元格格式中的自定义的度分秒（下图所示），就不能用拆分的方法就需要用提取字符串的方法，由于我的数据中两种格式都有，所以处起来比较麻烦，就需要有判断的语句，代码如下

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim D As Integer
Dim F As Integer
Dim M As Double
Dim LastRow As Integer
Dim vecSplit As Variant
LastRow = ActiveSheet.UsedRange.Rows.Count
Dim i As Integer
Dim value As String

For j = 12 To 13 'j是列
For i = 2 To LastRow 'i是行
value = Cells(i, j)
If (Cells(1, j) = "经度") Then
If (Cells(i, j) Like "*°*") Then
vecSplit = Split(Cells(i, j), "°", 2)
D = Val(vecSplit(0))
vecSplit = Split(vecSplit(1), "′", 2)
F = Val(vecSplit(0))
M = Val(vecSplit(1))
Cells(i, 18) = D + F / 60 + M / 3600
Else
D = Left(value, 3)
F = Mid(value, 4, 2)
M = Right(value, Len(value) - 5)
Cells(i, 18) = D + F / 60 + M / 3600
End If

ElseIf (Cells(1, j) = "纬度") Then
If (Cells(i, j) Like "*°*") Then
vecSplit = Split(Cells(i, j), "°", 2)
D = Val(vecSplit(0))
vecSplit = Split(vecSplit(1), "′", 2)
F = Val(vecSplit(0))
M = Val(vecSplit(1))
Cells(i, 19) = D + F / 60 + M / 3600
Else
D = Left(value, 2)
F = Mid(value, 3, 2)
M = Right(value, Len(value) - 4)
Cells(i, 19) = D + F / 60 + M / 3600
End If
End If
Next
End Sub

同样Worksheet_BeforeDoubleClick 为工作表的双击事件，当双击单元格表时就会触发这个事件