编程常用代码
Excel2007启用宏：OFFICE按钮→选项→信任中心→信任中心设置→宏设置
代码里可以命名名称，比如 rng1.Name = "data1" ，然后在公式中使用它
Debug.Print "7777" '在立即窗口中显示
Environ("Computername") '计算机名
Environ("userprofile") ‘ 桌面路径
ActiveWindow.Caption="XXXXX" '在显示文件名的地方显示XXXXX
Windows(ThisWorkbook.Name).Visible = False '隐藏excel主窗口ThisWorkbook.Name[文件名]
-------
文件和文件夹
当前文件夹的名称：CurDir
更改文件或文件夹的名称：（Name 原文件 As 新文件）
检查文件或文件夹是否存在：m=Dir(文件,Nomal) m=Dir(文件夹,Folder)Directory
创建文件夹（MkDir "D：\文件夹名"）
f = Dir("D:\省份分表", vbDirectory) '判断是否已经存在
If f = "" Then MkDir ("D:\省份分表") '如果不存在就建立
删除文件：（Kill "D：\文件夹名\成品.xls"
删除空文夹：（RmDir "D：\文件夹名"）
---------
复制文件：（FileCopy）
For i = 101 To 10000
FileCopy "D:\迅雷.txt", "D:\文件夹名\" & i & "迅雷.txt"
Next
With Application.FileSearch
.Filename = "*.*"
.LookIn = ThisWorkbook.Path & "\分表"
.Execute
k = .FoundFiles.Count '文件夹中的文件个数
End With
Sub 生成目录() '有子文件夹也查到
Set fs = Application.FileSearch
With fs
.LookIn = "D:\暂用\" '设置要查的起始目录
.Filename = "*.*"
.SearchSubFolders = True '是否查子目录
.Execute '根据上面的设置执行查
For i = 1 To .FoundFiles.Count '遍历文件
a = Dir(.FoundFiles(i))
Cells(i + 1, 3) = a
Next i
End With
End Sub
Shell " " & k & "\生成的表\", vbMaximizedFocus '展开文件夹
Sub 动态读取指定文件夹名()
On Error Resume Next
Dim stMedd As String
stMedd = "请选择文件目录："
Set obMapp = CreateObject("Shell.Application").BrowseForFolder(0, stMedd, &H1)
If Not obMapp Is Nothing Then
Directory = obMapp.self.Path & "\" '文件夹名
[G1].Value = Directory
Else
Exit Sub
End If
Call FilesList.FilesList
End Sub
变量
模块级变量的声明格式Public Directory
Dim x As Integer '声明变量
Byte (0到255的整数) Integer % (-32768+32768) Date (日期) String $ (65400个字符) Decimal (小数)
Long & Single ! Currency @
Format(32, "0000")简单好玩的编程代码复制 ‘Format格式结果为：0032
Dim Arr()
数组
ReDim Preserve Arr(1 To r) ‘声明动态数组
Array函数 Application.Transpose ‘转置
数组下限LBound(Arr)=0 ，数组上限 UBound(Arr)=4
Erase arr ’清空数组
IsArray ’指出变量是否为一个数组
If Application.CountA(Arr)>0 Then '判断数组不为空
Range("A1:D1") = Array("'1001", "现金", 300000, Date) '在一行多列中依次输入不同数据
Range("A1:A4") = Application.Transpose(Array("1001", "现金", 300000, Date)) 在一列多行中次输入不同数
Sub 字典 ()
r = Sheet1.Range("A65536").End(xlUp).Row '最后行数
Set w = CreateObject("scripting.dictionary")
For i = 2 To r
b = Sheet1.Cells(i, 2)
c = Sheet1.Cells(i, 3)
If ists(b & c) Then
w(b & c) = 1
Else
W(b & c) = W(b & c) + 1
End If
Next
[A2].Resize(w.Count, 1) = Application.Transpose(w.keys)
[B2].Resize(w.Count, 1) = Application.Transpose(w.items)
End Sub
Sub 用字典筛选多列()
r = Range("A65536").End(xlUp).Row '最后行数
Set w = CreateObject("scripting.dictionary")
For i = 2 To r
If Cells(i, 6) > 70 Then '语文分数为条件
w(Range(Cells(i, 1), Cells(i, 12))) = 1 '数据一行多列载入字典
End If
Next i
[N2].Resize(w.Count, 12) = Application.Transpose(Application.Transpose(w.keys)) '两次转置写入单元格
End Sub
If "dfg" Like "*f* " Then 判断字符串包含关系可用通配符
For Each st In Worksheets
With Chr(10) Exit For step 步长 ElseIf Else Do While … Loop
Application.ScreenUpdating = False '禁用刷新
Application.DisplayStatusBar = False '禁用状态显示
Application.Calculation = xlCalculationManual '手动重算
Application.EnableEvents = False '禁用触发事件
ActiveSheet.DisplayPageBreaks = False '禁用新版本
Application.ScreenUpdating = true '启用刷新
Application.DisplayStatusBar = true'显示状态
Application.EnableEvents = true '启用触发事件
Application.Calculation = xlAutomatic '自动重算
ActiveSheet.DisplayPageBreaks = true '启用新版本
Application.SheetsInNewWorkbook = 1 '设置工作簿内的工作表数
Application.SendKeys "%{down}" '自动打开数据有效性列表
Workbooks("学习.xls").Worksheets("Sheet1").Range("A4").ClearContents '从文件到单元格
Cells(4, 1) Rang("A4") [A4] '单元格
Range("H3").Select '选定单元格
Range("A65536").End(xlUp) '最后行单元数据
x=Range("A65536").End(xlUp).Row '行数
x = Range("e2").End(xlDown).Row ''向下查
Range("IV1").End(xlToLeft) '最后列单元数据
Range("IV1").End(xlToLeft).Column '列数
UsedRange.Cells 工作表使用区域的单元格
a = ActiveSheet.UsedRange.Item(ActiveSheet.UsedRange.Count).Row '格式最后行
b = ActiveSheet.UsedRange.Item(ActiveSheet.UsedRange.Count).Column '格式最后列
Cells(a, b) '最后一个单元格（不一定有数据）
(Cells(1, 1), Cells(a, b)) '数据最大区间起于A1单元格，止于最右下角单元格
f= Replace(mid(Cells(100,103).Address,2,2),"$","") ' 由列数得到列标CY
版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。
发表评论