excel中的VB实战范例

Sub Macro2()

' Macro2 Macro

' 快捷键: Ctrl+Shift+E

'删除0~7000行中C列单元格中的换行后的空格（一般是1~2个）

Dim i As Integer

Dim temp_str As String

i = 0

While i < 7000

If Cells(i, 3) Like "*" & Chr(10) & "*" Then

Cells(i, 3).Value = Replace(Cells(i, 3).Value, Chr(10) & " ", Chr(10))

If Cells(i, 3) Like "*" & Chr(10) & "*" Then

Cells(i, 3).Value = Replace(Cells(i, 3).Value, Chr(10) & " ", Chr(10))

End If

End If

i = i + 1

Wend

 

End sub

 

 

 

'将所有C列单元格中的“定义”后到第一个“{”之间的换行删除

Sub Macro1()

Dim i As Integer

Dim pos As Integer

Dim sub_str As String

Dim sub_str2 As String

Dim temp_str As String

i = 0

While i < 7000

If Cells(i + 3) Like "*〔字义〕*" Then

pos = Application.WorksheetFunction.Find("〔字义〕", Cells(i, 3))

temp_str = Mid(Cells(i, 3), pos + 4)

pos = Application.WorksheetFunction.Find("〔", temp_str)

sub_str = Mid(temp_str, pos)

If sub_str Like "*" & Chr(10) & "*" Then

sub_str2 = Replace(sub_str, Chr(10), "")

Cells(i, 3).Value = Replace(Cells(i + 3), sub_str, sub_str2)

End If

End If

i = i + 1

Wend

End Sub

 

 

Sub Macro1()

' Macro1 Macro

' 宏由 USER 录制，时间: 2009-12-6

' 快捷键: Ctrl+Shift+C

'复制单元格到下一列个单元格，并将右边单元格的内容加上"拼音"文本后插入到下一列单元格中

'最后将原单元格所在行删除

Dim curr_row As Integer

Dim curr_col As Integer

Dim pinyin As String

Dim temp As String

Dim wubi_pos As Integer

 curr_row = Selection.Row

curr_col = Selection.Column

Cells(curr_row, curr_col).Select

Selection.Copy

Cells(curr_row + 1, curr_col).Select

ActiveSheet.Paste

Cells(curr_row, curr_col + 1).Select

pinyin = Cells(curr_row, curr_col + 1).Value

 

Cells(curr_row + 1, curr_col + 1).Select

temp = " {拼音}" & pinyin & Chr(10)

Cells(curr_row + 1, curr_col + 1).Value = temp & Cells(curr_row + 1, curr_col + 1).Value

 Rows(curr_row).Delete

End Sub

 

///

''代码片段

Dim pos%, w$

If Cells(Selection.Row, Selection.Column) Like "*〔五笔字母〕*" Then

pos = Application.WorksheetFunction.Find("〔五笔字母〕", Cells(Selection.Row, Selection.Column))

Dim wubi_str As String

Dim wubi_big As String

 

wubi_str = Mid(Cells(Selection.Row, Selection.Column).Value, pos + 6, 4)

wubi_big = UCase(wubi_str)

Cells(Selection.Row, Selection.Column).Value = Replace(Cells(Selection.Row, Selection.Column).Value, wubi_str, wubi_big, 1)

End if

Dim i As Integer

i = 1

While i < 7500

If Cells(i, 3) Like "*※偏正式*" Then

Dim pos_pian As Integer

Dim pian_fir As String

Dim pian_last As String

pos_pian = Application.WorksheetFunction.Find("※偏正式", Cells(i, 3))

pian_fir = Mid(Cells(i, 3).Value, pos_pian, 9)

If pian_fir Like "*〔*" Then

pian_last = Replace(pianfir, "〔", "(")

Cells(i, 3).Value = Replace(Cells(i, 3).Value, pian_fir, pian_last, 1)

End If

End If

i = i + 1

Wend