Excel常見宏命令詳解

清除剪貼板

Sub 清除剪貼板()

Application.CutCopyMode = False

Application.CommandBars("TaskPane").Visible = False

End Sub

批量清除軟回車

Sub 批量清除軟回車()

"也可直接使用Alt+10或13替換

Cells.Replace What:=Chr(10), Replacement:="",LookAt:=xlPart, SearchOrder:= _

xlByRows, MatchCase:=False,SearchFormat:=False, ReplaceFormat:=False

End Sub

判斷指定文件是否已經打開

Sub 判斷指定文件是否已經打開()

Dim x As Integer

For x = 1 To Workbooks.Count

If Workbooks(x).Name = "函數.xls" Then "文件名稱

MsgBox "文件已打開"

Exit Sub

End If

Next

MsgBox "文件未打開"

End Sub

當前文件另存到指定目錄

Sub 當前激活文件另存到指定目錄()

ActiveWorkbook.SaveAsFilename:="E:信件" & ActiveWorkbook.Name

End Sub

另存指定文件名

Sub 另存指定文件名()

ActiveWorkbook.SaveAsThisWorkbook.Path & "別名.xls"

End Sub

以本工作表名稱另存文件到當前目錄

Sub 以本工作表名稱另存文件到當前目錄()

ActiveWorkbook.SaveAsFilename:=ThisWorkbook.Path & "" & ActiveSheet.Name &".xls"

End Sub

將本工作表單獨另存文件到Excel當前默認目錄

Sub 將本工作表單獨另存文件到Excel當前默認目錄()

ActiveSheet.Copy

ActiveWorkbook.SaveAsFilename:=ActiveSheet.Name & ".xls"

End Sub

以活動工作表名稱另存文件到Excel當前默認目錄

Sub 以活動工作表名稱另存文件到Excel當前默認目錄()

ActiveWorkbook.SaveAsFilename:=ActiveSheet.Name & ".xls", FileFormat:= _

xlNormal, Password:="",WriteResPassword:="", ReadOnlyRecommended:=False _

, CreateBackup:=False

End Sub

另存所有工作表為工作簿

Sub 另存所有工作表為工作簿()

Dim sht As Worksheet

Application.ScreenUpdating= False

ipath = ThisWorkbook.Path& ""

For Each sht In Sheets

sht.Copy

ActiveWorkbook.SaveAs ipath & sht.Name& ".xls" "(工作表名稱為文件名）

"ActiveWorkbook.SaveAs ipath & sht.Name& Trim(sht.[d15]) & ".xls" "（文件名稱 & D15單元內容）

"ActiveWorkbook.SaveAs ipath &Trim(sht.[d15]) & ".xls""（文件名稱為D15單元內容）

ActiveWorkbook.Close

Next

Application.ScreenUpdating= True

End Sub

以指定單元內容為新文件名另存文件

Sub 以指定單元內容為新文件名另存文件()

ThisWorkbook.SaveAsFilename:=ThisWorkbook.Path & "" & Sheet1.[A1]

End Sub

以當前日期為新文件名另存文件

Sub 以當前日期為新文件名另存文件()

ThisWorkbook.SaveAsThisWorkbook.Path & "" & Format(Now(), "yyyymmdd")& ".xls"

End Sub

Sub 以當前日期為名稱另存文件()

ActiveWorkbook.SaveAsFilename:=Date & ".xls"

End Sub

以當前日期和時間為新文件名另存文件

Sub 以當前日期和時間為新文件名另存文件()

ThisWorkbook.SaveAsThisWorkbook.Path & "" & Format(Now(), "yyyy"& "年" & "mm" &"月" & "dd" & "日" & "h" & "時"& "mm" & "分" &"ss" & "秒") &".xls"

End Sub

另存本表為TXT文件

Sub 另存本表為TXT文件()

Dim s As String

Dim FullName As String, rng As Range

Application.ScreenUpdating = False

FullName = (ActiveSheet.Name &".txt") "以當前表名為TXT文件名

" FullName = Replace(ThisWorkbook.FullName,".xls", ".txt") "以當前文件名為TXT文件名

" FullName = Replace(ThisWorkbook.FullName,".xls", ActiveSheet.Name & ".txt") "以文件名&表名為TXT文件名

Open FullName For Output As #1 "以讀寫方式打開文件，每次寫內容都會覆蓋原先的內容

"參考幫助，fullname為文件全名

For Each rng InRange("a1").CurrentRegion

s = s & IIf(s = "","", "|") &rng.Value

If rng.Column =Range("a1").CurrentRegion.Columns.Count Then

Print #1, s & "|" "把數據寫到文本文件里

s = ""

End If

Next

Close #1"關閉文件

Application.ScreenUpdating = True

MsgBox "數據已導入文本"

End Sub

引用指定位置單元內容為部分文件名另存文件

Sub 引用指定位置單元內容為部分文件名另存文件()

ActiveWorkbook.SaveAsFilename:="E:信件" & "解答" & Range("sheet1!a1") & "郎雀.xls"

End Sub

將A列數據排序到D列

Sub 將A列數據排序到D列()

[d:d] = [a:a].Value

[d:d].SortKey1:=Range("D1"), Order1:=xlAscending, Header:=xlYes

End Sub

將指定範圍的數據排列到D列

Sub 將指定範圍的數據排列到D列()

Dim arr1, arr2, i%, x

arr1 =Range("A1:C3")

ReDim arr2(1 ToUBound(arr1, 1) * UBound(arr1, 2), 1 To 1)

For Each x InApplication.Transpose(arr1)

i = i + 1

arr2(i, 1) = x

Next x

Range("D1").Resize(i,1) = arr2

End Sub

游標移動

Sub 游標移動()

ActiveCell.Offset(1, 2).Select "向下移動1行，向右移動2列

End Sub

游標所在行上移一行

Sub 游標所在行上移一行()

Dim i%

i = Split(ActiveCell.Address,"$")(2)

If i > 1 Then

Rows(i).Cut

Rows(i - 1).Insert Shift:=xlDown

End If

End Sub

加數據有效限制

Sub 加數據有效限制()

With Selection.Validation

.Delete

.Add Type:=xlValidateList,AlertStyle:=xlValidAlertStop, Operator:= _

xlBetween, Formula1:="bigsun010@sina.com"

.IgnoreBlank = False

.InCellDropdown = False

.InputTitle = ""

.ErrorTitle = ""

.InputMessage = ""

.ErrorMessage = "要奮鬥就會有犧牲，死人的事是經常發生的。"

.IMEMode = xlIMEModeNoControl

.ShowInput = True

.ShowError = True

End With

End Sub

取消數據有效限制

Sub 取消數據有效限制()

With Selection.Validation

.Delete

.Add Type:=xlValidateInputOnly,AlertStyle:=xlValidAlertStop, Operator _

:=xlBetween

.IgnoreBlank = False

.InCellDropdown = False

.InputTitle = ""

.ErrorTitle = ""

.InputMessage = ""

.ErrorMessage = ""

.IMEMode = xlIMEModeNoControl

.ShowInput = True

.ShowError = True

End With

End Sub