實(shí)例41-拆分中文英文數(shù)字

Private Sub CommandButton處理_Click()

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

.Columns(2).ClearContents

.Columns(3).ClearContents

.Columns(4).ClearContents

For i = 1 To .Range("A1000000").End(xlUp).Row

If .Cells(i, 1) <> "" Then

.Cells(i, 2) = 提取中文(.Cells(i, 1))

.Cells(i, 3) = 提取英文(.Cells(i, 1))

.Cells(i, 4) = 提取數(shù)字(.Cells(i, 1))

End If

Next i

.Activate

End With

End Sub

Function 提取中文(ByVal extractdata As String) As String

提取中文 = ""

Dim extrattext As String

Dim ei As Long

Dim itemchar As String

Dim extract_array() As String

Dim extract_i

For ei = 1 To Len(extractdata)

itemchar = Mid(extractdata, ei, 1)

If itemchar Like "[一-龥](méi)" Then

extrattext = extrattext & itemchar

End If

Next ei

提取中文 = extrattext

End Function

Function 提取數(shù)字(ByVal extractdata As String) As String

提取數(shù)字 = ""

Dim extrattext As String

Dim ei As Long

Dim itemchar As String

Dim extract_array() As String

Dim extract_i

For ei = 1 To Len(extractdata)

itemchar = Mid(extractdata, ei, 1)

If IsNumeric(itemchar) Then

extrattext = extrattext & itemchar

End If

Next ei

提取數(shù)字 = extrattext

End Function

Function 提取英文(ByVal extractdata As String) As String

提取英文 = ""

Dim extrattext As String

Dim ei As Long

Dim itemchar As String

Dim extract_array() As String

Dim extract_i

For ei = 1 To Len(extractdata)

itemchar = Mid(extractdata, ei, 1)

If itemchar Like "[a-zA-Z]" Then

extrattext = extrattext & itemchar

End If

Next ei

提取英文 = extrattext

End Function

實(shí)例42-兩列交叉合并

Private Sub CommandButton處理_Click()

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

If Trim(.Cells(2, "C").Value) = "" Or Trim(.Cells(5, "C").Value) = "" Then

MsgBox "參數(shù)不能為空"

Exit Sub

End If

'定義變量

Dim startrow As Long

startrow = Trim(.Cells(2, "C").Value)

Dim stoprow As Long

stoprow = Trim(.Cells(5, "C").Value)

End With

'處理

Dim i

Dim addcount As Long

With ThisWorkbook.Worksheets("合并結(jié)果")

.Columns(1).ClearContents

For i = startrow To stoprow

addcount = addcount + 1

.Cells(addcount, 1) = ThisWorkbook.Worksheets("原數(shù)據(jù)").Cells(i, 1)

addcount = addcount + 1

.Cells(addcount, 1) = ThisWorkbook.Worksheets("原數(shù)據(jù)").Cells(i, 2)

Next i

.Activate

End With

End Sub

實(shí)例43-一列交叉拆分為兩列

Private Sub CommandButton處理_Click()

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

If Trim(.Cells(2, "C").Value) = "" Or Trim(.Cells(5, "C").Value) = "" Then

MsgBox "參數(shù)不能為空"

Exit Sub

End If

'定義變量

Dim startrow As Long

startrow = Trim(.Cells(2, "C").Value)

Dim stoprow As String

stoprow = Trim(.Cells(5, "C").Value)

End With

'處理

Dim i

Dim addcount As Long

With ThisWorkbook.Worksheets("拆分結(jié)果")

.Columns(1).ClearContents

.Columns(2).ClearContents

For i = startrow To stoprow Step 2

addcount = addcount + 1

.Cells(addcount, 1) = ThisWorkbook.Worksheets("原數(shù)據(jù)").Cells(i, 1)

.Cells(addcount, 2) = ThisWorkbook.Worksheets("原數(shù)據(jù)").Cells(i + 1, 1)

Next i

.Activate

End With

End Sub