【实例13-分割数据至多个单元格】【实例14-合并多个单元格数据】Excel表格VBA编程实例
实例13-分割数据至多个单元格

Private Sub CommandButton分割数据_Click()
'分割符号不能为空
With ThisWorkbook.Worksheets("操作界面")
Dim splittext As String
If .Cells(5, "C").Value <> "" Then
splittext = .Cells(5, "C").Value
Else
MsgBox "请输入分割符号"
Exit Sub
End If
'处理内容不能为空
Dim splitcontent As String
If .Cells(8, "B").Value <> "" Then
splitcontent = .Cells(8, "B").Value
Else
MsgBox "请输入处理内容"
Exit Sub
End If
End With
'清除处理结果
With ThisWorkbook.Worksheets("处理结果")
.Columns(1).ClearFormats
.Columns(1).ClearContents
'分割数据
Dim split_array
split_array = Split(splitcontent, splittext)
Dim i
For i = 0 To UBound(split_array)
.Cells(i + 1, 1).Value = split_array(i)
Next i
.Activate
End With
End Sub
实例14-合并多个单元格数据

Private Sub CommandButton合并数据_Click()
'合并符号不能为空
With ThisWorkbook.Worksheets("操作界面")
Dim mergetext As String
If .Cells(4, "C").Value <> "" Then
mergetext = .Cells(4, "C").Value
Else
MsgBox "请输入合并符号"
Exit Sub
End If
'合并区域不能为空
Dim mergerange As String
If .Cells(7, "C").Value <> "" Then
mergerange = .Cells(7, "C").Value
Else
MsgBox "请输入合并区域地址"
Exit Sub
End If
'清除原结果区域
.Cells(10, "B").Value = ""
'合并数据
Dim itemcell
Dim mergeresult As String
For Each itemcell In ThisWorkbook.Worksheets("待合并数据").Range(mergerange)
If itemcell.Value <> "" Then
If mergeresult <> "" Then
mergeresult = mergeresult & mergetext & itemcell.Value
Else
mergeresult = itemcell.Value
End If
End If
Next
.Cells(10, "B").Value = mergeresult
End With
End Sub