實(shí)例13-分割數(shù)據(jù)至多個(gè)單元格

Private Sub CommandButton分割數(shù)據(jù)_Click()

'分割符號(hào)不能為空

With ThisWorkbook.Worksheets("操作界面")

Dim splittext As String

If .Cells(5, "C").Value <> "" Then

splittext = .Cells(5, "C").Value

Else

MsgBox "請輸入分割符號(hào)"

Exit Sub

End If

'處理內(nèi)容不能為空

Dim splitcontent As String

If .Cells(8, "B").Value <> "" Then

splitcontent = .Cells(8, "B").Value

Else

MsgBox "請輸入處理內(nèi)容"

Exit Sub

End If

End With

'清除處理結(jié)果

With ThisWorkbook.Worksheets("處理結(jié)果")

.Columns(1).ClearFormats

.Columns(1).ClearContents

'分割數(shù)據(jù)

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

實(shí)例14-合并多個(gè)單元格數(shù)據(jù)

Private Sub CommandButton合并數(shù)據(jù)_Click()

'合并符號(hào)不能為空

With ThisWorkbook.Worksheets("操作界面")

Dim mergetext As String

If .Cells(4, "C").Value <> "" Then

mergetext = .Cells(4, "C").Value

Else

MsgBox "請輸入合并符號(hào)"

Exit Sub

End If

'合并區(qū)域不能為空

Dim mergerange As String

If .Cells(7, "C").Value <> "" Then

mergerange = .Cells(7, "C").Value

Else

MsgBox "請輸入合并區(qū)域地址"

Exit Sub

End If

'清除原結(jié)果區(qū)域

.Cells(10, "B").Value = ""

'合并數(shù)據(jù)

Dim itemcell

Dim mergeresult As String

For Each itemcell In ThisWorkbook.Worksheets("待合并數(shù)據(jù)").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