失眠网,内容丰富有趣,生活中的好帮手!
失眠网 > Excel vba开发 合并单元格拆分自动填充功能 在每一条数据后面插入空白行 将地理坐

Excel vba开发 合并单元格拆分自动填充功能 在每一条数据后面插入空白行 将地理坐

时间:2020-01-31 11:47:36

相关推荐

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 为工作表的双击事件,当双击单元格表时就会触发这个事件

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

如果觉得《Excel vba开发 合并单元格拆分自动填充功能 在每一条数据后面插入空白行 将地理坐》对你有帮助,请点赞、收藏,并留下你的观点哦!

本内容不代表本网观点和政治立场,如有侵犯你的权益请联系我们处理。
网友评论
网友评论仅供其表达个人看法,并不表明网站立场。