Excel宏程序
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
Sub Macro2()
'i = 1
r = 1
Do While Sheet1.Cells(i, 1) <> ""
Do While Sheet1.Cells(i, 4) <> ""
i = i + 1
Loop '查找第四列为空的i 行
Do While Sheet1.Cells(i + 1, 4) = ""
i = i + 1
Loop '查找i 行且i+1 行不为空
r = i
i = i + 1
Do While Sheet1.Cells(i, 4) <> ""
Sheet1.Cells(r, 4) = Sheet1.Cells(r, 4) & " " & Sheet1.Cells(i, 4)
Rows(i).Select
Selection.Delete Shift:=xlUp
Loop
Loop
h = MsgBox("执行完毕!", 1)
End Sub
Sub Macro3()
'i = 1
r = 1
Do While Sheet1.Cells(i, 1) <> ""
Do While Sheet1.Cells(i, 2) = ""
i = i + 1
Loop '查找第二列不为空的i 行
r = i
i = i + 1
Do While Sheet1.Cells(i, 2) <> ""
If Sheet1.Cells(i, 2) = Sheet1.Cells(r, 2) Then
Sheet1.Cells(i, 2) = ""
i = i + 1
Else
r = i
i = i + 1
End If
Loop
Loop
h = MsgBox("执行完毕!", 1)
'End Sub
Sub 按钮1_单击()
s = Cells(1, 1)
Cells(2, 1) = Right(s, Len(s) - InStrRev(s, "\")) End Sub
放在cells(1,1)中的.
还一个方法是
a=split(s,"\")
cells(2,1)=a(ubound(a))
Sub 字符分割()
Dim B
i = 0
h = 1
Do While Sheet1.Cells(h, 1) <> ""
s = Cells(h, 1)
B = Split(s, "|")
Do While i <= UBound(B)
If B(i) <> "" Then
Sheet1.Cells(h, i + 1) = B(i)
End If
i = i + 1
Loop
h = h + 1
i = 0
Loop
h = MsgBox("执行完毕!" & h, 1)
End Sub
Sub 取消单引号()
Dim rn As Range, r As Range
Dim sh As Worksheet
Set rn = edRange
For Each r In rn
If r.PrefixCharacter = "'" Then
t = r.Value
r.ClearComments
r.NumberFormatLocal = "@"
r.Value = t
End If
Next
End Sub
If SN = vbNullString Then SN =
If RN = 0 Then RN = ActiveCell.Row() '就是这一行，不知用什么办法引用才能等效于公式里的Row() CN = Excel.WorksheetFunction.Match(CT, Sheets(SN).Rows(1), 0)
sCol = Sheets(SN).Cells(RN, CN).Value
End Function
Sub 上下复制()
'
' 上下复制Macro
' 宏由许长安录制，时间: 2016-1-5
' Range("C131").Select
' Selection.Copy
' Range("C132").Select
' ActiveSheet.Paste
' Range("C133").Select
Row = 0
Col = 0
i = 1
j = 1
h = 1
Row = ActiveCell.Row()
Col = ActiveCell.Column()
Do While (Sheet1.Cells(Row, Col) <> "" And Row < 1500)
Do While (Sheet1.Cells(Row + i, Col) = "" And i < 400)
Sheet1.Cells(Row + i, Col) = Sheet1.Cells(Row, Col)
i = i + 1
Loop
Row = Row + i
i = 1
Loop
h = MsgBox("执行完毕!" & Row & "|" & Col, 1)
End Sub