注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

零售创新,创新那些事儿,SPSS,VBA

零售创新

 
 
 

日志

 
 
关于我

新浪微博,零售创新 研究经理,数据分析师 希望和市场研究和零售业的同事共同进步! 本博客发表的都是免费或试用的资料,如果有版权问题请发邮件wangli12a@163.com联系删除。 spss excel vba blog

网易考拉推荐

学用的VBA语句  

2009-02-09 16:44:56|  分类: VB和VBA知识 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

A65536].End(xlUp).Row 'A列末行向上第一个有值的行数
[A1].End(xlDown).Row 'A列首行向下第一个有值之行数
[IV1].End(xlToLeft).Column '第一行末列向左第一列有数值之列数。
[A1].End(xlToRight).Column '第一行首列向右有连续值的末列之列数
Application.CommandBars("Standard").Controls(2).BeginGroup=True '在常用工具栏的第二个按钮前插入分隔符
Cells.WrapText = False '取消自动换行
If Len(Target) > 5 Then '如果当前单元格中的字符数超过5个,执行下一行
Target.WrapText = True '自动换行
End If

[A1:B10].SpecialCells(xlCellTypeBlanks).Rows.Hidden = True '有空格即隐藏行
[A2].parent.name '返回活动单元格的工作表名
[A2].parent.parent.name '返回活动单元格的工作簿名
如下代码可使工作簿打开后30秒(或闲置30秒)内不输入、不重新选择等,自动关闭工作簿
Private Sub Workbook_Open() '工作簿打开事件
tt '工作簿打开时启动 tt 过程
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) '工作表变化事件
tt '工作表中任一单元格有变化时启动 tt 过程
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) '工作表选择变化事件
tt '工作表中单元格的选择有变化时启动 tt 过程
End Sub
Sub tt() 'tt 过程
Dim myNow As Date, BL As Integer '定义myNow为日期型;定义BL为长整型
myNow = Now '把当前的时间赋给变量myNow
Do '开始循环语句Do
BL = Second(Now) - Second(myNow) '循环中不断检查变量BL的值
If BL = 30 Then GoTo Cl '当BL=30即跳转到CL
DoEvents '转让控制权,以便sheets可继续操作
Loop Until BL > 30 '当BL>30即跳出循环
Exit Sub
Cl:
Application.EnableEvents = False '避免引起其他事件
ActiveWorkbook.Close True '关闭活动工作簿并保存
Application.EnableEvents = True '可触发其他事件
End Sub
range("e4").addcomment.Text "代头" & Chr(10) & "内容……" '添加批注
range("e4").Comment.Visible = True '显示批注
把工作簿中所有工作表的指定列调整为最佳列宽:
Sub 调整列宽()
Dim i%
For i = 1 To Sheets.Count '遍历工作簿中所有的工作表
Sheets(i).Columns("A:K").AutoFit '把每个工作表的[A:K]列调整为最佳列宽
Next i
End Sub
Do循环语句的几种形式:
1.
Do While i>1 '条件为True时执行
... ... '要执行的语句
Loop
2.
Do Until i>1 '条件为False时执行
... ... '要执行的语句
Loop
3.
Do
... ... '要执行的语句
Loop While i>1 '条件为True时执行
4.
Do
... ... '要执行的语句
Loop Until i>1 '条件为False时执行
5.While...Wend 语句
While i>1 '条件为True时执行
... ... '要执行的语句
Wend
勾选"VBA项目的信任"
Application.SendKeys "%(tmstv){ENTER}" '在 Excel 窗口操作
Application.SendKeys "%(qtmstv){ENTER}" '在 VBE 窗口操作
Application.CommandBars("命令按钮名称").Position = msoBarFloating '使[命令按钮]悬浮在表格中
Application.CommandBars("命令按钮名称").Position = msoBarTop '使[命令按钮]排列在工具栏中
ActiveSheet.protect Password:="wshzw" '为工作表保护加口令
ActiveSheet.Unprotect Password:="wshzw" '解除工作表保护
Activesheet.ProtectContents '判断工作表是否处于保护状态
工作表的复制与命名
Sub wshzw()
Dim i As Integer
For i = 1 To 5
Sheets("Sheet1").Copy After:=Sheets(1) 'Before/After 复制新表在 Sheets("Sheet1") 前/后
ActiveSheet.Name = i & "月" '为复制的新表命名
Next i
Sheets("Sheet1").Name = "总表" '为 Sheets("Sheet1") 改名
End Sub
Application.EnableEvents = False
......
Application.EnableEvents = True '抑制事件连锁执行
Application.EnableEvents = False
ActiveWorkbook.Save '抑制BeforeSave事件的发生
Application.EnableEvents = True '抑制指定事件
Application.DisplayAlerts=False '屏蔽确认提示
Application.ScreenUpdating = False
.......
Application.ScreenUpdating = true ' 冻结屏幕以加快程序运行

ActiveCell.CurrentRegion.Select '选择与活动单元格相连的区域
range("a2:a20").NumberFormatLocal = "00-00" '区域的格式化
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row '已用区域的最末行
ActiveSheet.Copy Before:=Sheets(1) '复制活动工作表到第一张工作表之前
range("a2:a20").FormulaHidden = True '工作表处于保护状态时隐藏部分单元格公式

FileDateTime("E:\My Documents\33.xls")

FileDateTime(thisworkbook.FullName) '文件被创建或最后修改后的日期和时间
FileLen(thisworkbook.FullName) / 1024

FileLen("E:\My Documents\temp\33.xls") / 1024 '文件的长度(大小),单位是 KB
Application.AskToUpdateLinks = False '不询问是否更新链接,并自动更新链接
ActiveSheet.Hyperlinks.Delete '删除活动工作表超链接
ActiveWorkbook.SaveLinkValues = False '不保存活动工作簿的外部链接值
ActiveSheet.PageSetup.CenterFooter = Range("k2").Value '打印时设置自定义页脚
ActiveSheet.PageSetup.Orientation = xlLandscape '设置为横向打印
ActiveSheet.PageSetup.Orientation = xlPortrait '设置为纵向打印
Application.WindowState = xlMinimized '最小化窗口
Application.WindowState = xlNormal '最大化窗口
Sub 删除工作表()
Application.DisplayAlerts = False
Sheet1.Delete
Application.DisplayAlerts = True
End Sub
有删除就有添加
Sub 添加工作表()
For i = 1 To 5
Worksheets.Add.Name = i
Next
End Sub
[A1:A20].AdvancedFilter xlFilterCopy, [B1], Unique:=True '可去掉重复数据
[A2:C32].Replace What:="F", Replacement:="G" '指定范围内的查找与替换
Activesheet.AutoFilterMode = false '取消自动筛选
执行以下语句可有效缩小工作簿的大小,执行前请先看清每条语句的作用:
ActiveSheet.UsedRange.ClearComments '清除活动工作表已使用范围所有批注
ActiveSheet.UsedRange.ClearFormats '清除活动工作表已使用范围所有格式
ActiveSheet.UsedRange.Validation.Delete '取消活动工作表已使用范围的数据有效性
ActiveSheet.Hyperlinks.Delete '删除活动工作表超链接
ActiveSheet.DrawingObjects.Delete '删除活动工作表已使用范围的所有对象
ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value '取消活动工作表已使用范围的公式并保留值
还有:
Sub x()
Dim myRange As String
myRange = ActiveSheet.UsedRange.Address '去除活动工作表无数据的行列
End Sub
  评论这张
 
阅读(791)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017