Excel VBA常用代码总结1

Excel VBA常用代码总结1

改变背景色

Range("A1").Interior.ColorIndex = xlNone ColorIndex一览

改变文字颜色

Range("A1").Font.ColorIndex = 1

获取单元格

Cells(1, 2)

Range("H7")

获取范围

Range(Cells(2, 3), Cells(4, 5))

Range("a1:c3")

'用快捷记号引用单元格

Worksheets("Sheet1").[A1:B5]

选中某sheet

Set NewSheet = Sheets("sheet1")

NewSheet.Select

选中或激活某单元格

'“Range”对象的的Select方法可以选择一个或多个单元格，而Activate方法可以指定某一个单元格为活动单元格。

'下面的代码首先选择A1:E10区域，同时激活D4单元格：

Range("a1:e10").Select

Range("d4:e5").Activate

'而对于下面的代码：

Range("a1:e10").Select

Range("f11:g15").Activate

'由于区域A1:E10和F11:G15没有公共区域，将最终选择F11:G15，并激活F11单元格。

获得文档的路径和文件名

ActiveWorkbook.Path'路徑

https://www.sodocs.net/doc/7d18951150.html,'名稱

ActiveWorkbook.FullName'路徑＋名稱

'或将ActiveWorkbook换成thisworkbook

隐藏文档

Application.Visible = False

禁止屏幕更新

Application.ScreenUpdating = False

禁止显示提示和警告消息

Application.DisplayAlerts = False

文件夹做成

strPath = "C:\temp\"

MkDir strPath

状态栏文字表示

Application.StatusBar = "计算中"

双击单元格内容变换

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If(Target.Cells.Row >= 5And Target.Cells.Row <= 8) Then

If Target.Cells.Value = "●"Then

Target.Cells.Value = ""

Else

Target.Cells.Value = "●"

End If

Cancel = True

End If

End Sub

文件夹选择框方法1

Set objShell = CreateObject("Shell.Application")

Set objFolder = objShell.BrowseForFolder(0, "文件", 0, 0)

If Not objFolder Is Nothing

Then path= objFolder.self.Path & "\"

end if

Set objFolder = Nothing

Set objShell = Nothing

文件夹选择框方法2（推荐）

Public Function ChooseFolder() As String

Dim dlgOpen As FileDialog

Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)

With dlgOpen

.InitialFileName = ThisWorkbook.path & "\"

If .Show = -1Then

ChooseFolder = .SelectedItems(1)

End If

End With

Set dlgOpen = Nothing

End Function

'使用方法例：

Dim path As String

path = ChooseFolder()

If path <> ""Then

MsgBox"open folder"

End If

文件选择框方法

Public Function ChooseOneFile(Optional TitleStr As String = "Please choose a file", Optional TypesDec As String = "*.*", Optional Exten As String = "*.*") As String

Dim dlgOpen As FileDialog

Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker) With dlgOpen

.Title = TitleStr

.Filters.Clear

.Filters.Add TypesDec, Exten

.AllowMultiSelect = False

.InitialFileName = ThisWorkbook.Path

If .Show = -1Then

' .AllowMultiSelect = True

' For Each vrtSelectedItem In .SelectedItems

' MsgBox "Path name: " & vrtSelectedItem

' Next vrtSelectedItem

ChooseOneFile = .SelectedItems(1)

End If

End With

Set dlgOpen = Nothing

End Function

某列到关键字为止循环方法1(假设关键字是end)

Set CurrentCell = Range("A1")

Do While CurrentCell.Value <> "end"

……

Set CurrentCell = CurrentCell.Offset(1, 0)

Loop

某列到关键字为止循环方法2(假设关键字是空字符串)

i = StartRow

Do While Cells(i, 1) <> ""

……

i = i + 1

Loop

"For Each...Next 循环(知道确切边界)

For Each c In Worksheets("Sheet1").Range("A1:D10").Cells

If Abs(c.Value) < 0.01Then c.Value = 0

Next

"For Each...Next 循环(不知道确切边界),在活动单元格周围的区域内循环For Each c In ActiveCell.CurrentRegion.Cells

If Abs(c.Value) < 0.01Then c.Value = 0

Next

某列有数据的最末行的行数的取得(中间不能有空行)

lonRow=1

Do While Trim(Cells(lonRow, ２).Value) <> ""

lonRow = lonRow + 1

Loop

lonRow11 = lonRow11 - 1

A列有数据的最末行的行数的取得另一种方法

Range("Ａ65536").End(xlUp).Row

将文字复制到剪贴板

Dim MyData As DataObject

Set MyData = New DataObject

MyData.SetText Range("H7").Value

MyData.PutInClipboard

取得路径中的文件名

Private Function GetFileName(ByVal s As String)

Dim sname() As String

sname = Split(s, "\")

GetFileName = sname(UBound(sname))

End Function

取得路径中的路径名

Private Function GetPathName(ByVal s As String)

intFileNameStart = InStrRev(s, "\")

GetPathName = Mid(s, 1, intFileNameStart)

End Function

由模板sheet拷贝做成一个新的sheet

ThisWorkbook.Worksheets("template").Copy

After:=ThisWorkbook.Worksheets(Sheets.Count)

Set doc_s = ThisWorkbook.Worksheets(Sheets.Count)

doc_https://www.sodocs.net/doc/7d18951150.html, = "newsheetname" & Format(Now, "yyyyMMddhhmmss")

选中当列的最后一个有内容的单元格(中间不能有空行)

'删除B3开始到B列最后一个有内容的单元格为止的所有内容

Range("B3").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.ClearContents

常量定义

Private Const StartRow As Integer = 3

判断sheet是否存在

Private Function IsWorksheet(ByVal strSeetName As String) As Boolean On Error GoTo ErrHandle

Dim blnRet As Boolean

blnRet = IsNull(Worksheets(strSeetName))

IsWorksheet = True

Exit Function

ErrHandle:

IsWorksheet = False

End Function

向单元格中写入公式

Worksheets("Sheet1").Range("D6").Formula = "=SUM(D2:D5)"

引用命名单元格区域

Range("MyBook.xls!MyRange")

Range("[Report.xls]Sheet1!Sales"

选定命名的单元格区域

Application.Goto Reference:="MyBook.xls!MyRange"

'或者

worksheets("sheetname").range("rangename").select

Selection.ClearContents

使用Dictionary

'使用Dictionary需要添加参照Microsoft Scripting Runtime

Dim dic As New Dictionary

dic.Add "Table", "Cards"'前面是Key 后面是Value

dic.Add "Serial", "serialno"

dic.Add "Number", "surface"

MsgBox dic.Item("Table") '由Key取得Value

dic.Exists("Table") '判断某Key是否存在

将EXCEL表格中的两列表格插入到一个Dictionary中

'函数：在ws工作表中，从iStartRow行开始到没有数据为止，把iKeyCol 列和iKeyCol右一列插入到一个字典中，并返回字典。

Public Function SetDic(ws As Worksheet, iStartRow, iKeyCol As Integer) As Dictionary

Dim dic As New Dictionary

Dim i As Integer

i = iStartRow

Do Until ws.Cells(i, iRuleCol).Value = ""

If Not dic.Exists(ws.Cells(i, iKeyCol).Value) Then

dic.Add ws.Cells(i, iKeyCol).Value, ws.Cells(i, iKeyCol + 1).Value

End If

i = i + 1

Loop

Set SetDic = dic

End Function

判断文件夹或文件是否存在

'文件夹

If Dir("C:\aaa", vbDirectory) = ""Then

MkDir"C:\aaa"

End If

'文件

If Dir("C:\aaa\1.txt") = ""Then

msgbox"文件C:\aaa\1.txt不存在"

end if

一次注释多行

视图---工具栏---编辑调出编辑工具栏，工具栏上有个“设置注释块” 和“解除注释快”

打开文件并将文件赋予到第一个参数wb中

'注意，这里的path是文件的完整路径，包括文件名。

Public Function OpenWorkBook(wb As Workbook, path As String) As Boolean

On Error GoTo Err

OpenWorkBook = True

Dim isWbOpened As Boolean

isWbOpened = False

Dim fileName As String

fileName = GetFileName(path)

'check file is opened or either

Dim wbTemp As Workbook

For Each wbTemp In Workbooks

If https://www.sodocs.net/doc/7d18951150.html, = fileName Then isWbOpened = True Next

'open file

If isWbOpened = False Then

Workbooks.Open path

End If

Set wb = Workbooks(fileName)

Exit Function

Err:

OpenWorkBook = False

End Function

打开一个文件，并将文件赋予到wb中，将文件的sheet页赋予到ws中的完整代码。（用到了上面的函数）

'If OpenWorkBook(wb, path & "\" & "filename") = False Then MsgBox"open file error."

GoTo Err

End If

wb.Activate

Set ws = wb.Worksheets("sheetname")

打开一个不知道确切名字的文件（文件名中含有serachname），并将文件赋予到wb中，将文件的sheet页赋予到ws中的完整代码。

'用到了上上面的函数OpenWorkBook

'If OpenCompanyFile(wb, path, "searchname") = False Then

MsgBox"open file error."

GoTo Err

End If

wb.Activate

Set ws = wb.Worksheets("sheetname")

'直接使用的函数OpenCompanyFile

Function OpenCompanyFile(wbCom As Workbook, strPath As String, strFileName As String) As Boolean

Dim fs As Variant

fs = Dir(strPath & "\*.xls") 'seach files

OpenCompanyFile = False

Do While fs <> ""

If InStr(1, fs, strFileName) > 0Then'file name match

If OpenWorkBook(wbCom, strPath & "\" & fs) = False Then 'open file

OpenCompanyFile = False

Exit Do

Else

OpenCompanyFile = True

Exit Do

End If

End If

fs = Dir

Loop

End Function

数字转字母（如1转成A，2转成B）和字母转数字

Chr(i + 64)

比如i=1的时候，Chr(i + 64)=A

Asc(i - 64)

比如i=A的时候，Asc(i - 64)=1

复选框总开关实现。假如有10个子checkbox1~checkbox10，还有一个总开关checkbox11，让checkbox11控制1~10的选择和非选择。

Private Sub CheckBox11_Click()

Dim chb As Variant

If Me.CheckBox11.Value = True Then

For Each chb In ActiveSheet.OLEObjects

If https://www.sodocs.net/doc/7d18951150.html, Like "CheckBox*"And https://www.sodocs.net/doc/7d18951150.html, <> "CheckBox11" Then

chb.Object.Value = True

End If

Next

Else

For Each chb In ActiveSheet.OLEObjects

If https://www.sodocs.net/doc/7d18951150.html, Like "CheckBox*"And https://www.sodocs.net/doc/7d18951150.html, <> "CheckBox11" Then

chb.Object.Value = False

End If

Next

End If

End Sub

修改B6单元格所在的pivot的数据源，并刷新pivot

Set pvt = ActiveSheet.Range("B6").PivotTable

pvt.ChangePivotCache

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

"SheetName!R4C2:R" & lngLastRow & "C22",

Version:=xlPivotTableVersion10)

pvt.PivotCache.Refresh

将一个图形（比如一个长方形的框"Rectangle 2"）移动到与某个单元格对齐。

ws.Activate

Application.ScreenUpdating = True

ws.Shapes.Range(Array("Rectangle 2")).Select

ws.Shapes.Range(Array("Rectangle 2")).Top = ws.Range("T5").Top

ws.Shapes.Range(Array("Rectangle 2")).Left = ws.Range("T5").Left

Application.ScreenUpdating = False

遍历控件。比如遍历所有的checkbox是否被打挑。

If Me.OLEObjects("CheckBox" & i).Object.Value = True Then

flgChecked = True

end if

得到今天的日期

dateNow = WorksheetFunction.Text(Now(), "YYYY/MM/DD")

在某个sheet页中查找某个关键字

'****************************************************

'Search keyword from a worksheet(not workbook!)

'****************************************************

Public Function SearchKeyWord(ws As Worksheet, keyword As String) As Boolean

Dim var1 As Variant

Set var1 = ws.Cells.Find(What:=keyword, After:=ActiveCell, LookIn:=xlFormulas, LookAt _

:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _

False, MatchByte:=False, SearchFormat:=False)

If var1 Is Nothing Then

SearchKeyWord = False

Else

SearchKeyWord = True

End If

End Function

单元格为空，取不到值的时候，转化为空字符串。Empty to ""

'****************************************************

'Empty to ""

'****************************************************

Public Function ChangeEmptyToString(var As Variant) As String On Error GoTo Err

ChangeEmptyToString = CStr(var)

Exit Function

Err:

ChangeEmptyToString = ""

End Function

单元格为空，取不到值的时候，转化为0。Empty to 0

'****************************************************

'Empty to 0

'****************************************************

Public Function ChangeEmptyToLong(var As Variant) As Long On Error GoTo Err

ChangeEmptyToLong = CLng(var)

Exit Function

Err:

ChangeEmptyToLong = 0

End Function

找到某个sheet页中使用的最末行

https://www.sodocs.net/doc/7d18951150.html,edRange.Rows.Count

遍历文件夹下的所有文件（自定义文件夹和后缀名），并返回文件列表字典

Function SetFilesToDic(ByVal path As String, ByVal extension As String) As Dictionary

Dim MyFile As String

Dim s As String

Dim count As Integer

Dim dic As New Dictionary

If Right(path, 1) <> "\"Then

path = path & "\"

End If

MyFile = Dir(path & "*." & extension)

count = 1

Do While MyFile <> ""

' If MyFile = "" Then

' Exit Do

' End If

dic.Add count, MyFile

count = count + 1

MyFile = Dir

Loop

Set SetFilesToDic = dic

' Debug.Print s

End Function

生成log

Sub txtPrint(ByVal txt$, Optional myPath$ = "") '第2参数可以指定保存txt文件路径

If myPath = ""Then myPath = ActiveWorkbook.path & "\log.txt"

Open myPath For Append As #1

Print #1, txt

Close #1

End Sub

  [Non-Breaking Space]网页空格在VBA中的处理

替换字符

ChrB(160) & ChrB(0)

上述最终解决方法来自于

https://www.sodocs.net/doc/7d18951150.html,/board/FUM20060608180224R4M/BRD2009031 011234606U/2.html

Sdany用户是通过如下思路找到解决方法的（用MidB和AscB）：

Dim I As Integer

For I = 1To LenB(Cells(1, 1))

Debug.Print AscB(MidB(Cells(1, 1), I, 1))

Next

延时

这段代码在Excel VBA 和VB里都可以用

'***********VB 延时函数定义************************************* '声明

Private Declare Function timeGetTime Lib"winmm.dll" () As Long '延时

Public Sub Delay(ByVal num As Integer)

Dim t As Long

t = timeGetTime

Do Until timeGetTime - t >= num * 1000

DoEvents

Loop

End Sub

'***************************************************************

使用方法:

delay 3'3表示秒数

杀掉某程序执行的所有进程

Sub KillWord()

Dim Process

For Each Process In GetObject("winmgmts:").ExecQuery("select * from Win32_Process where name='WINWORD.EXE'")

Process.Terminate (0)

Next

End Sub

监视某单元格的变化

这里最需要注意的问题就是，如果在这个事件里对单元格进行改变，会继续出发此事件变成死循环。

所以要在对单元格进行变化之前加上Application.EnableEvents = False，变完之后再改为True。

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo Err

Application.EnableEvents = False

Dim c

Set dicKtoW = SetDic(ThisWorkbook.Sheets("reference"), 3, 1, 2)

Set dicKtoX = SetDic(ThisWorkbook.Sheets("reference"), 3, 1, 3)

For Each c In Target

If c.Column = 11Then

'MsgBox c.Value

Me.Range("W" & c.Row).Value = GetDic(dicKtoW, c.Value)

Me.Range("X" & c.Row).Value = GetDic(dicKtoX, c.Value) End If

excelvba常见字典用法集锦及代码详解(全)

常见字典用法集锦及代码详解 前言 凡是上过学校的人都使用过字典，从新华字典、成语词典，到英汉字典以及各种各样数不胜数的专业字典，字典是上学必备的、经常查阅的工具书。有了它们，我们可以很方便的通过查找某个关键字，进而查到这个关键字的种种解释，非常快捷实用。 凡是上过EH论坛的想学习VBA里面字典用法的，几乎都看过研究过northwolves狼版主、oobird版主的有关字典的精华贴和经典代码。我也是从这里接触到和学习到字典的，在此，对他们表示深深的谢意，同时也对很多把字典用得出神入化的高手们致敬，从他们那里我们也学到了很多，也得到了提高。 字典对象只有4个属性和6个方法，相对其它的对象要简洁得多，而且容易理解使用方便，功能强大，运行速度非常快，效率极高。深受大家的喜爱。 本文希望通过对一些字典应用的典型实例的代码的详细解释来

给初次接触字典和想要进一步了解字典用法的朋友提供一点备查的参考资料，希望大家能喜欢。 给代码注释估计是大家都怕做的，因为往往是出力不讨好的，稍不留神或者自己确实理解得不对，还会贻误他人。所以下面的这些注释如果有不对或者不妥当的地方，请大家跟帖时指正批评，及时改正。 字典的简介 字典（Dictionary）对象是微软Windows脚本语言中的一个很有用的对象。 附带提一下，有名的正则表达式（RegExp）对象和能方便处理驱动器、文件夹和文件的（FileSystemObject）对象也是微软Windows脚本语言中的一份子。 字典对象相当于一种联合数组，它是由具有唯一性的关键字（Key）和它的项（Item）联合组成。就好像一本字典书一样，是

Excel VBA常用代码VSTO版20150425

21-1 使用工作表的名称 this.Application.Worksheets["工作表2"].Activate(); 21-2 使用工作的索引号 this.Application.Worksheets[2].Activate(); 21-3 使用工作表的代码名称 MessageBox.Show(this.Application.ActiveSheet.CodeName); 21-4 用ActiveSheet属性引用活动工作表 this.Application.Worksheets[2].Select(); MessageBox.Show(https://www.sodocs.net/doc/7d18951150.html,); 22-1 选择工作表的方法 this.Application.Worksheets[2].Select(); this.Application.Worksheets[2].Activate(); 23-1 使用For遍历工作表 intwkCount = this.Application.Worksheets.Count; string s = string.Empty; for (inti = 1; i<= wkCount; i++) { s = s + this.Application.Worksheets[i].Name + "\n"; } MessageBox.Show("工作簿中含有以下工作表:" + "\n" + s); 23-2 使用ForEach语句 string s = string.Empty; foreach (Excel.Worksheetwk in this.Application.Worksheets) { s = s + https://www.sodocs.net/doc/7d18951150.html, + "\n"; } MessageBox.Show("工作簿中含有以下工作表:" + "\n" + s); 24-1 在工作表中向下翻页 Excel.Sheetsshs=Globals.ThisWorkbook.Worksheets; Excel.WorksheetwkThis = shs.Application.ActiveSheet; Excel.WorksheetwkNext; intwkIndex = wkThis.Index; intwkCount = shs.Count; if (wkIndex

EXCEL常用VBA代码

删除B列中字符串数值少于21的单元格所在的行 Sub 删除行() r = Range("B65536").End(xlUp).Row '行数 For h = r To 1 Step -1 If Cells(h, 2) < 21 Then Cells(h, 2).EntireRow.Delete Next End Sub ------------------------- 【工作表合并】将同一工作簿中的所有工作表合并到一个工作表中 新建一个工作表，写入代码[在新建的工作表标签处右键查看代码（找不到的直接按一下alt+F11) 把下面的代码复制进去然后点上面的运行运行子程序即可]： Sub 合并当前工作簿下的所有工作表() Application.ScreenUpdating = False For j = 1 To Sheets.Count If Sheets(j).Name <> https://www.sodocs.net/doc/7d18951150.html, Then X = Range("A65536").End(xlUp).Row + 1 Sheets(j).UsedRange.Copy Cells(X, 1) End If Next Range("B1").Select Application.ScreenUpdating = True MsgBox "当前工作簿下的全部工作表已经合并完毕！", vbInformation, "提示" End Sub ********************************************************* 代码这样写也行： Sub c() For i = Sheets.Count To 2 Step -1 Sheets(i).Select Sheets(i).UsedRange.Copy Sheets(1).Select Cells(Cells(65000, 1).End(xlUp).Row + 1, 1).Select ActiveSheet.Paste 'Sheets(i).Delete Next i End Sub ************************************************************ 把一个工作簿中的所有表单合并成一个表单，怎么去掉重复的表头、标题行？方法如下：

Excel VBA常用代码总结1

Excel VBA常用代码总结1 改变背景色 Range("A1"). = xlNone ColorIndex一览 改变文字颜色 Range("A1"). = 1 获取单元格 Cells(1, 2) Range("H7") 获取范围 Range(Cells(2, 3), Cells(4, 5)) Range("a1:c3") '用快捷记号引用单元格 Worksheets("Sheet1").[A1:B5] 选中某sheet Set NewSheet = Sheets("sheet1") 选中或激活某单元格 '“Range”对象的的Select方法可以选择一个或多个单元格，而Activate方法可以指定某一个单元格为活动单元格。 '下面的代码首先选择A1:E10区域，同时激活D4单元格： Range("a1:e10").Select

Range("d4:e5").Activate '而对于下面的代码： Range("a1:e10").Select Range("f11:g15").Activate '由于区域A1:E10和F11:G15没有公共区域，将最终选择F11:G15，并激活F11单元格。 获得文档的路径和文件名 '路径 '名称 '路径＋名称 '或将ActiveWorkbook换成thisworkbook 隐藏文档 = False 禁止屏幕更新 = False 禁止显示提示和警告消息 = False 文件夹做成 strPath = "C:\temp\" MkDir strPath 状态栏文字表示 = "计算中" 双击单元格内容变换 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If>= 5And<= 8) Then If= "●"Then = "" Else = "●" End If Cancel = True End If End Sub 文件夹选择框方法1 Set objShell = CreateObject("") Set objFolder = (0, "文件", 0, 0) If Not objFolder Is Nothing Then path= & "\" end if

EXCELVBA常用代码实战大全共393页word资料

VBA常用技巧代码解析 yuanzhuping 1VBA VBAVBA VBA常用 常用常用 常用技巧 技巧技巧 技巧 目录 目录目录 目录 VBA VBAVBA VBA常用技巧 常用技巧常用技巧 常用技巧 ------------------------------------------------------------------------------------------------------- 1 第1章 Range（单元格）对象 -------------------------------------------------------------------- 10 技巧1 单元格的引用方法 ---------------------------------------------------------------------- 10 1-1 使用Range属性 ----------------------------------------------------------------------- 10 1-2 使用Cells属性 ------------------------------------------------------------------------ 11 1-3 使用快捷记号 -------------------------------------------------------------------------- 11 1-4 使用Offset属性 ----------------------------------------------------------------------- 12 1-5 使用Resize属性 ----------------------------------------------------------------------- 13 1-6 使用Union方法 ----------------------------------------------------------------------- 14 1-7 使用UsedRange属性 ---------------------------------------------------------------- 14 1-8 使用CurrentRegion属性 ------------------------------------------------------------ 15 技巧2 选定单元格区域的方法---------------------------------------------------------------- 15 2-1 使用Select方法 ----------------------------------------------------------------------- 15 2-2 使用Activate方法 -------------------------------------------------------------------- 16 2-3 使用Goto方法 ------------------------------------------------------------------------- 17 技巧3 获得指定行、列中的最后一个非空单元格 -------------------------------------- 17 技巧4 定位单元格 ------------------------------------------------------------------------------- 20

Excel VBA编程的常用代码

用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！ 使用Dim语句 Dim a as integer '声明a为整型变量 Dim a '声明a为变体变量 Dim a as string '声明a为字符串变量 Dim a as currency ,b as currency ,c as currency '声明a,b,c为货币变量 ...... 声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal（当前不支持）、Date、String（只限变长字符串）、String * length（定长字符串）、Object、Variant、用户定义类型或对象类型。 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是 Private。 Const My = 456 ' 声明 Public 常数。 Public Const MyString = "HELP" ' 声明 Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 3.4567 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就

可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。 Sub My_Select Selection.CurrentRegion.Select End sub 返回当前单元格中数据删除前后空格后的值 sub my_trim msgbox Trim(ActiveCell.Value) end sub 单元格位移 sub my_offset ActiveCell.Offset(0, 1).Select'当前单元格向左移动一格 ActiveCell.Offset(0, -1).Select'当前单元格向右移动一格 ActiveCell.Offset(1 , 0).Select'当前单元格向下移动一格 ActiveCell.Offset(-1 , 0).Select'当前单元格向上移动一格 end sub 如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往 sub my_offset 之下加一段代码 on error resume next 注意以下代码都不再添加sub “代码名称” 和end sub请自己添加! 给当前单元格赋值 ActiveCell.Value = "你好！！！" 给指定单元格赋值 例如：Ａ１单元格内容设为"ＨＥＬＬＯ" Range("a1").value="hello" 又如：你现在的工作簿在sheet1上，你要往sheet2的Ａ１单元格中插入"ＨＥＬＬＯ" 1. sheets("sheet2").select

ExcelVBA常用代码VSTO版

Excel VBA常用代码VSTO版(C#) 1-1使用Range属性 this.Range["A3:F6, B1:C5"].Select(); 1-2使用Cells属性 for(int icell=1;icell<=100;icell++) { this.Application.Worksheets[2].cells[icell, 1].value = icell; } 1-3使用快捷记号 #N/A 1-4使用Offset属性 this.Range["A1:A3"].Offset[3, 3].Select(); 1-5使用Resize属性 this.Range["A1"].Resize[3, 3].Select(); 1-6使用Union属性 this.Application.Union(this.Range["A1:D4"], this.Range["E5:H8"]).Select(); 1-7使用UsedRange属性 https://www.sodocs.net/doc/7d18951150.html,edRange.Select(); 1-8使用CurrentRegion属性 this.Range["A5"].CurrentRegion.Select(); 2-1 使用Select方法 this.Application.Worksheets[3].Activate(); this.Application.Worksheets[3].Range["A1:B10"].Select(); 2-2 使用Activate方法 this.Application.Worksheets[3].Activate(); this.Application.Worksheets[3].Range["A1:B10"].Activate(); 注:此处的代码,可以运行,但是只会选中A1这一个单元格 2-3 使用Goto方法

excel代码大全

excel代码大全.txt第一次笑是因为遇见你，第一次哭是因为你不在，第一次笑着流泪是因为不能拥有你。EXCEL宏代码大全 本文件部分文章来源于网络，文章版权归原作者所有，如果本站转载的文章侵犯了您的权益请及时联系我们，我们将尽快妥善处理。本站除部分特别声明禁止转载的专稿外，其他文章可以自由转载，但请务必注明原出处和作者。 000. A列半角内容变红 Sub A列半角内容变红() Dim rg As Range, i As Long = False For Each rg In (xlCellTypeConstants, 3) For i = 1 To Len(rg) If Asc(Mid(rg, i, 1)) 001. A列等于A列减B列 Sub A列等于A列减B列() For i = 1 To 23 Cells(i, 1) = Cells(i, 1) - Cells(i, 2) Next End Sub 002. B列录入数据时在A列返回记录时间（工作表代码） Public Sub Worksheet_Change(ByVal Target As Range) If = 2 Then (, -1) = Now End If End Sub 003. Excel宏常用代码 本大类暂没有内容，以下是关于本类的所有记录集。 004. Sub 以当前日期为名称另存文件() Filename:=Date & ".xls" End Sub 005. Sub 启用保存() ("File").Controls(4).Enabled = True ("File").Controls(5).Enabled = True End Sub 006. Sub 执行前需要验证密码的宏()

Excel VBA编程的常用代码

Excel VBA编程的常用代码 用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！ 使用Dim语句 Dim a as integer '声明a为整型变量 Dim a '声明a为变体变量 Dim a as string '声明a为字符串变量 Dim a as currency ,b as currency ,c as currency '声明a,b,c为货币变量 ...... 声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal （当前不支持）、Date、String（只限变长字符串）、String * length（定长字符串）、Object、Variant、用户定义类型或对象类型。 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数

用来代替文字值。 Const ' 常数的默认状态是Private。 Const My = 456 ' 声明Public 常数。 Public Const MyString = "HELP" ' 声明Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 3.4567 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。 Sub My_Select Selection.CurrentRegion.Select End sub 返回当前单元格中数据删除前后空格后的值 sub my_trim msgbox Trim(ActiveCell.Value)

Excel VBA 常用代码50例

Excel VBA 常用代码50例 001。用命令按扭打印一个sheet1中B2:M30区域中的内容? 我想在Sheet2中制件一个命令按扭, 打印表Sheet1中的[B2:M30] 区域中的内容? 解答：可以将打印区域设为b2：m30，然后打印，如：sheets("sheet1").printarea="b2:m30" sheets("sheet1").printout 随手写的，你可以试试看。最简单的方法是：你先录制宏，在录制宏过程中，跑到页面设臵里面，把打印范围设臵到你想要的范围。 然后退出，停止录制宏，你就可以得到一些代码！ 002。能否对一列中的文字统一去掉最后一个字?这些文字不统一,有些字数多,有些字数少。如何处理?我用{"&-}不行 解答：=REPLACE(A1,LEN(A1),1," ")(在过渡列进行) 003.能否根据单元格数值自动标记序号？ 各位大佬，一工作表有两列，“序号”及“金额”，能否将金额不等于0的行自动标上序号呢？如无现成的函数，应怎样设臵？ 解答：Dim xuhao As Integer xuhao = 1

Range("b2").Select Do While Selection <> "" If Selection <> 0 Then ActiveCell.Previous.Value = xuhao xuhao = xuhao + 1 End If ActiveCell.Offset(1, 0).Range("a1").Select Loop 004.求教自定义函数 查询了一些自定义函数的例子都是单变量的。自定义函数能否建立“(As Range) As Interger”的函数，应该可以的，请各位大师赐教！请以“∑x2”为例，万分感谢！(该用"For Each ...Next"，就是还不知道如何引用Range中的每个值，请高手指点。) 解答：参数使用Range而函数值为Integer是可以的 用for each next循环思路也是对的，应该这样作： dim rg as range dim ivalue as integer for each rg in 参数区域 ivalue=ivalue+rg.value next

excelvba编程的常用代码

强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是 Private。 Const My = 456 ' 声明 Public 常数。 Public Const MyString = "HELP" ' 声明 Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。Sub My_Select End sub 返回当前单元格中数据删除前后空格后的值 sub my_trim msgbox Trim end sub

单元格位移 sub my_offset (0, 1).Select'当前单元格向左移动一格 (0, -1).Select'当前单元格向右移动一格 (1 , 0).Select'当前单元格向下移动一格 (-1 , 0).Select'当前单元格向上移动一格 end sub 如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往 sub my_offset 之下加一段代码 on error resume next 注意以下代码都不再添加sub “代码名称” 和end sub请自己添加! 给当前单元格赋值 = "你好！！！" 给指定单元格赋值 例如：Ａ１单元格内容设为"ＨＥＬＬＯ" Range("a1").value="hello" 又如：你现在的工作簿在sheet1上，你要往sheet2的Ａ１单元格中插入"ＨＥＬＬＯ" 1. sheets("sheet2").select range("a1").value="hello" 或 2. Sheets("sheet1").Range("a1").Value = "hello" 说明： 被选中，然后在将“HELLO"赋到A1单元格中。 不必被选中，即可“HELLO"赋到sheet2 的A1单元格中。

Excel VBA编程常用代码

Excel VBA编程常用代码 时间:2009-12-05 22:36:04 来源:本站作者:未知我要投稿我要收 藏投稿指南 用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！使用Dim语句 Dim a as integer '声明a为整型变量 Dim a '声明a为变体变量 Dim a as string '声明a为字符串变量 Dim a as currency ,b as currency ,c as currency '声明a,b,c为货币变量...... 声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal（当前不支持）、Date、String（只限变长字符串）、String * length （定长字符串）、Object、Variant、用户定义类型或对象类型。 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是 Private。 Const My = 456 ' 声明 Public 常数。 Public Const MyString = "HELP" ' 声明 Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 3.4567 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。 Sub My_Select Selection.CurrentRegion.Select End sub 返回当前单元格中数据删除前后空格后的值 sub my_trim msgbox Trim(ActiveCell.Value) end sub 单元格位移 sub my_offset ActiveCell.Offset(0, 1).Select'当前单元格向左移动一格

Excel-VBA常用技巧代码

多个工作薄合并成同一个工作薄，如何合并？ 多人填一个同样的工作薄，形成了多个工作薄。如何让几人填了一部分的工作薄合并成终稿。 Sub 汇总() Dim mypath As String, myname As String, Dname As String, sh As Workbook, copyrow As Integer Set sh = ThisWorkbook mypath = ThisWorkbook.Path myname = https://www.sodocs.net/doc/7d18951150.html, Dname = Dir(mypath & "\*.xls") Application.ScreenUpdating = False Do While Dname <> "" If Dname <> myname Then copyrow = 1 With GetObject(mypath & "\" & Dname) For i = 1 To .Worksheets.Count If .Sheets(i).Cells(5, 3) <> "" Then .Sheets(i).Rows("1:" & .Sheets(i).UsedRange.Rows.Count).Copy sh.Sheets(i).Cells(copyrow, 1) End If Next .Close False End With End If Dname = Dir Loop Application.ScreenUpdating = True MsgBox "OK!" End Sub

合并工作簿：将其他工作簿的全部表合并到本工作 Sub 合并工作簿() Dim FilesToOpen Dim x As Integer On Error GoTo ErrHandler Application.ScreenUpdating = False FilesToOpen = Application.GetOpenFilename _ (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _ MultiSelect:=True, Title:="Files to Merge") If TypeName(FilesToOpen) = "Boolean" Then MsgBox "No Files were selected" GoTo ExitHandler End If x = 1 While x <= UBound(FilesToOpen) Workbooks.Open Filename:=FilesToOpen(x) Sheets().Move After:=ThisWorkbook.Sheets _ (ThisWorkbook.Sheets.Count) x = x + 1 Wend ExitHandler: Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox Err.Description Resume ExitHandler End Sub Sub 合并工作表() For Each st In Worksheets If https://www.sodocs.net/doc/7d18951150.html, <> https://www.sodocs.net/doc/7d18951150.html, Then https://www.sodocs.net/doc/7d18951150.html,edRange.Offset(1, 0).Copy [a65536].End(xlUp).Offset(1, 0) Next End Sub

VBA常用代码

1.遍历所有已打开的word文档 For Each docOpened In Documents …… Next docOpened 2.Word 将目录下所有文档转换为txt，并删除原文档 Sub 目录下doc转txt() '目录下所有word文档转为txt，并删除word文档 '保存在原目录 '遍历所有文件夹，把带路径的文件名存入字典 On Error Resume Next Dim Path As String, t 'Path为路径,t用于计算程序执行花费的时间 Set objshell = CreateObject("Shell.Application") Set objfolder = objshell.BrowseForFolder(0, "选择文件夹", 0, 0) If Not objfolder Is Nothing Then Path = objfolder.sel f.Path & "\" Set objfolder = Nothing Set objshell = Nothing '创建字典用于存储路径和文件名 Dim DicPath, DicFile, i As Integer, Ke, ContentName A s String, FileName As String, MsgTxt Set DicPath = CreateObject("Scripting.Dictionary")

Set DicFile = CreateObject("Scripting.Dictionary") DicPath.Add Path, "" i = 0 '存所有路径 Do While i < DicPath.count Ke = DicPath.keys ContentName = Dir(Ke(i), vbDirectory) Do While ContentName <> "" '若有子文件夹，则添加 '跳过当前的目录及上层目录 If ContentName <> "." And ContentName < > ".." Then If GetAttr(Ke(i) & ContentName) = vbDirectory Then DicPath.Add (Ke(i) & Conte ntName & "\"), "" End If End If ContentName = Dir Loop i = i + 1 Loop '存所有doc文件名 For Each Ke In DicPath.keys FileName = Dir(Ke & "*.doc")

EXCEL VBA常用代码集

EXCEL VBA常用代码集 1.显示活动工作簿名称 MsgBox "当前活动工作簿是" & https://www.sodocs.net/doc/7d18951150.html, 2.保存活动工作簿 Activeworkbook.Save 3.保存所有打开的工作簿关闭EXCEL For Each W in Application.Workbooks W.Save Next W Application.Quit 4.将网格线设置为蓝色 ActiveWindow.GridlineColorIndex = 5 5.将工作表sheet1隐藏 Sheet1.Visible = xlSheetV eryHidden 6.将工作表Shtte1显示 Sheet1.Visible = xlSheetVisible 7.单击某单元格,该单元格所在的行以蓝色背景填充,字体颜色为白色 Private Sub Worksheet_SelectionChange(ByV al Target As Excel.Range) If Target.Row >= 2 Then’第二行以下的区域 On Error Resume Next [ChangColor_With1].FormatConditions.Delete https://www.sodocs.net/doc/7d18951150.html, = "ChangColor_With1" With [ChangColor_With1].FormatConditions .Delete .Add xlExpression, , "TRUE" .Item(1).Interior.ColorIndex = 5 .Item(1).Font.ColorIndex = 2 End With End If End Sub 8.使窗体在启动的时候自动最大化 Private Sub UserForm_Initialize() Application.WindowState = xlMaximized With Application Me.Top = .Top Me.Left = .Left Me.Height = .Height Me.Width = .Width End With End Sub 9.不保存工作簿退出EXCEL Application.DisplayAlerts = False Application.Quit

Excel 宏编程的常用代码

Excel 宏编程的常用代码 用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！使用Dim语句 Dim a as integer '声明a为整型变量 Dim a '声明a为变体变量 Dim a as string '声明a为字符串变量 Dim a as currency ,b as currency ,c as currency '声明a,b,c为货币变量...... 声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal（当前不支持）、Date、String（只限变长字符串）、String * length（定长字符串）、Object、V ariant、用户定义类型或对象类型。 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是Private。 Const My = 456 ' 声明Public 常数。 Public Const MyString = "HELP" ' 声明Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 3.4567 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。 Sub My_Select Selection.CurrentRegion.Select End sub

VBA常用代码

VBA编程常用代码 用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！使用Dim语句 Dim a as integer '声明a为整型变量 Dim a '声明a为变体变量 Dim a as string '声明a为字符串变量 Dim a as currency ,b as currency ,c as currency '声明a,b,c为货币变量...... 声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal（当前不支持）、Date、String（只限变长字符串）、String * length （定长字符串）、Object、Variant、用户定义类型或对象类型。 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是 Private。 Const My = 456 ' 声明 Public 常数。 Public Const MyString = "HELP" ' 声明 Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 3.4567 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。 Sub My_Select Selection.CurrentRegion.Select End sub 返回当前单元格中数据删除前后空格后的值 sub my_trim msgbox Trim(ActiveCell.Value) end sub 单元格位移 sub my_offset ActiveCell.Offset(0, 1).Select'当前单元格向左移动一格 ActiveCell.Offset(0, -1).Select'当前单元格向右移动一格 ActiveCell.Offset(1 , 0).Select'当前单元格向下移动一格 ActiveCell.Offset(-1 , 0).Select'当前单元格向上移动一格

ExcelVBA常用代码总结1

Excel VBA常用代码总结1 ?改变背景色 Range("A1").Interior.ColorIndex = xlNone ColorIndex一览 ?改变文字颜色 Range("A1").Font.ColorIndex = 1 ?获取单元格 Cells(1, 2) Range("H7") ?获取围 Range(Cells(2, 3), Cells(4, 5)) Range("a1:c3") '用快捷记号引用单元格 Worksheets("Sheet1").[A1:B5] ?选中某sheet Set NewSheet = Sheets("sheet1") NewSheet.Select ?选中或激活某单元格 '“Range”对象的的Select方法可以选择一个或多个单元格，而Activate方法可以指定某一个单元格为活动单元格。 '下面的代码首先选择A1:E10区域，同时激活D4单元格： Range("a1:e10").Select

Range("d4:e5").Activate '而对于下面的代码： Range("a1:e10").Select Range("f11:g15").Activate '由于区域A1:E10和F11:G15没有公共区域，将最终选择F11:G15，并激活F11单元格。 ?获得文档的路径和文件名 ActiveWorkbook.Path '路徑 https://www.sodocs.net/doc/7d18951150.html, '名稱 ActiveWorkbook.FullName '路徑＋名稱 '或将ActiveWorkbook换成thisworkbook ?隐藏文档 Application.Visible = False ?禁止屏幕更新 Application.ScreenUpdating = False ?禁止显示提示和警告消息 Application.DisplayAlerts = False ?文件夹做成 strPath = "C:\temp\" MkDir strPath ?状态栏文字表示 Application.StatusBar = "计算中" ?双击单元格容变换 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If (Target.Cells.Row >= 5And Target.Cells.Row <= 8) Then If Target.Cells.Value = "●"Then Target.Cells.Value = "" Else Target.Cells.Value = "●" End If Cancel = True End If End Sub ?文件夹选择框方法1 Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder(0, "文件", 0, 0) If Not objFolder Is Nothing Then path= objFolder.self.Path & "\" end if