Excel word ppt office使用技巧大全(DOC格式)-第49部分

快捷操作: 按键盘上方向键 ← 或 → 可快速上下翻页 按键盘上的 Enter 键可回到本书目录页 按键盘上方向键 ↑ 可回到本页顶部! 如果本书没有阅读完，想下次继续接着阅读，可使用上方 "收藏到我的浏览器" 功能 和 "加入书签" 功能！



中全表—复制—　（在原位置）选择性粘贴—数值。请问用　VBA　语句如何编写？　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　388　　


…………………………………………………………Page　389……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



　　　　　解答：請參考　　



　　　　　　　　　　　With　　Cells　　



　　　　　　　　　　　　　　　　　。Copy　　



　　　　　　　　　　　　　　　　　。PasteSpecial　　Paste：=xlPastevalues　　



　　　　　　　　　　　　　　　　　。Cells（1；　　1）。Select　　



　　　　　　　　　　　　　　　　　Application。CutCopyMode　　=　　False　　



　　　　　　　　　　　End　　With　　



2、For　Each　x　in　所有公式单元格　　

　　　　　　　　If　Not　x。Formula　=　〃〃　Then　　

　　　　　　　　　　　　数值　=　x。value　　

　　　　　　　　　　　　x。Formula　=　〃〃　　

　　　　　　　　　　　　x。value　=　数值　　

　　　　　　　　End　If　　

Next　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　工作薄打开后个一分钟自动保存关闭，怎么写代码　　



1、　　　　　　　　在　thiswork　中写入代码：　　



　　　　　Private　　Sub　　Workbook_Open（）　　



　　　　　　　　　　　　　Me。RefreshAll　　



　　　　　　　　　　　　　Application。OnTime　　Now　　＋　　Timevalue　（〃00：01：00〃）；　　〃Close_Me〃　　



　　　　　End　　Sub　　



　　　　　添加模块并写入代码：　　



　　　　　Sub　　Close_Me（）　　



　　　　　　　　　　　　　ThisWorkbook。Save　　



　　　　　　　　　　　　　ThisWorkbook。Close　　



　　　　　End　　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　389　　


…………………………………………………………Page　390……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



　　　　　　　　　　　　　　　　　　　　　　　我想把一个　sheet　拷贝后选择性粘贴为一个新的　sheet；怎么做　　



答：添加模块：　　

Sub　test（）　　

　　　　　　　　ThisWorkbook。Save　　

　　　　　　　　Sheet1。Move　　

　　　　　　　　With　ActiveWorkbook。ActiveSheet。Cells　　

　　　　　　　　　　　　　　　　。Copy　　

　　　　　　　　　　　　　　　　。PasteSpecial　Paste：=xlPasteValues　　

　　　　　　　　　　　　　　　　。Cells（1；　1）。Select　　

　　　　　　　　　　　　　　　　Application。CutCopyMode　=　False　　

　　　　　　　　End　With　　

　　　　　　　　ThisWorkbook。Saved　=　True　　

　　　　　　　　ThisWorkbook。Close　　

End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　如何利用列标自动求和　　



当光标指在F1　时；能否利用　COLUMN（）求　A1…E1　和，当光标指在　G1　时；能否利用　COLUMN（）　

求　A1…F1　和；而不用改变公式，比如：SUM（A1：？）；就是说写个式子代替？；利用　COLUMN（）　自动算　

出最后列　　

1、=SUM（A1：INDIRECT（ADDRESS（ROW（）；COLUMN（）…1；4）））　　

应该为：=SUM（INDIRECT（〃R1C1：R1C〃&COLUMN（）…1；0））　　

2　、　　　　　　　　用　VB　　

新建一个工作表，在　sheet1　的代码窗口中录入如下代码：　　

Private　Sub　Worksheet_SelectionChange（ByVal　Target　As　Range）　　

Dim　iRow；　iCol；　iCol_rn　As　Integer　　

Dim　Str1　As　String　　

iRow　=　Target。Row　　

iCol　=　Target。Column　　

　　　　　　　　Range（〃M1〃）。ClearContents　　

　　　　　　　　iCol_rn　=　＇A1＇。End（xlToRight）。Column　　

　　　　　　　　Str1　=　Range（Cells（1；　iCol_rn）。Address）。Address　　

　　　　　　　　　　

　　　　　　　　If　Target。Rows。Count　》=　2　Then　GoTo　Err　　

　　　　　　　　If　iRow　=　1　And　iCol　》=　2　And　iCol　　2　And　Row　《　21　Then　　

　　　　　　　　

　　　　　　　　　　a　=　Target。Value　　

　　　　　　　　　　Target。Value　=　a　*　10。22　*　20　　

　　　　　　End　If　　

　　　　　　End　Sub　　

解答：Private　Sub　Worksheet_Change（ByVal　Target　As　Range）　　

　　　　Application。EnableEvents　=　False　　　　

　　　　　　If　Target。Column　=　6　And　Target。Row　》　2　And　Row　《　21　Then　　

　　　　　　　　

　　　　　　　　　　a　=　Target。Value　　

　　　　　　　　　　Target。Value　=　a　*　10。22　*　20　　

　　　　　　End　If　　

　　　　　　Application。EnableEvents　=　True　　

End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　自动输入　‘要点’两个字　　



工作表中有　500　行数据、F3　中包含红色的字符、F7　中包含红色的字符、。。。。。　　

想要达成的目的：如果　F　列的单元格中包含红色的字符，则在其同一行的　G　列中自动输入〃要　

点〃两个字。请高手赐教！！　　

解答：有一個取巧的方法；請參考　　

　　　　On　Error　Resume　Next　　

　　　　For　i　=　1　To　500　　

　　　　　　　　Color_Index　=　Cells（i；　〃F〃）。Font。ColorIndex　　

　　　　　　　　If　IsNull（Color_Index）　Then　　

　　　　　　　　　　　　Cells（i；　〃G〃）　=　〃要點〃　　

　　　　　　　　End　If　　

　　　　Next　i　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　表格更新　　



是这样的，比如我已经有了一个原始表格　A，这时有人通知我A　表有错误，须加以修改，并给　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　391　　


…………………………………………………………Page　392……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



我一个表　B，表B　列出了须修改的参数（注意　B　的列数少于A　的列数，因A　的其它列无需修改）。　

现在问题是如何根据表　B　中的新值，在表A　中找到相应位置，并加以修改。比如表B　中列出了　

10002　的JOHN　的身高和体重等值需要修改，如何在A　中找到　10002　的相应位置（身高体重），　

并加以修改。　　



解答：建议将表　B　复制至表　A　的　SHEET2，然后执行下列的宏即可　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　

Sub　change（）　　

Dim　dd　As　Range　　

Sheets（2）。Select　　

lastcell　=　Range（〃a65536〃）。End（xlUp）。Row　　

For　Each　dd　In　Range（Cells（2；　1）；　Cells（lastcell；　1））　　

If　dd　=　〃〃　Then　Exit　Sub　　

ff　=　dd。value　　

Set　c　=　Sheets（1）。Columns（1）。Find（ff；　lookat：=xlWhole）　　

If　Not　c　Is　Nothing　Then　　

c。Offset（0；　2）　=　dd。Offset（0；　2）　　

c。Offset（0；　3）　=　dd。Offset（0；　3）　　

c。Offset（0；　5）　=　dd。Offset（0；　4）　　

End　If　　

Next　　

End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　公式的自动填充　　



一张表中某几个不连续的列有公式，我不想一次全复制下去，最好是让它自动填充上一行的公　

式，这样用多少就自动填下去，不知道有没有办法。　　

解答：Dim　Mrow；　Xrow；　i　As　Integer　　

Mrow　=　Range（〃a65536〃）。End（xlUp）。Row　　

Xrow　=　Range（〃d65536〃）。End（xlUp）。Row　＋　1　　

Application。ScreenUpdating　=　False　　

For　i　=　Xrow　To　Mrow　　

If　Cells（i；　1）　　〃〃　Then　　

Cells（i；　4）　=　Cells（i　1；　4）　＋　Cells（i；　2）　Cells（i；　3）　　

Cells　（i；　6）　=　Cells（i；　2）　*　Cells（i；　5）　　

Cells（i；　8）　=　Cells（i　1；　8）　Cells（i；　7）　＋　Cells（i；　6）　　

Cells（i；　7）　=　Cells（i；　5）　*　Cells（i；　3）　　

End　If　　

Next　i　　

Application。ScreenUpdating　=　True　　

先输入其它列数据；最后再输入日期。　　



　　　　　　　　　　　　　　　　　　　　　　　我想　A1　的值=A1＋B1；其中B1　为变量，A1　为累计值　　



　解答　1：用VBA　实现。　　　

For　i=1　to　n　　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　392　　


…………………………………………………………Page　393……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



A1=sheet1。cells（1；1）　　　

A1=A1＋B1　　　

sheet1。cells（1；1）=A1　　　

next　n　　

解答　2：好象不用那么麻烦。选择B1　单元格，复制，选择　A1　单元格，选择性粘贴　（数值，加）　

即可。　　



　　　　　　　　　　　　让〃工资总计〃等于几个打开的各个工作薄的最后一个工作表中的〃工资〃和　　



解答：把几个〃工资〃单元格定义为名称〃工资〃（方法：插入/名称/定义；在引用位置中选中几个　

要相加的单元格；把这些区域定义为〃工资〃）；在〃工资总计〃中输入公式　=sum（工资）　即可！或：　

先打开宏记录器，然后你手工做一遍，最后停止纪录，在　vba　编辑其中编辑相应的代码即可！　

如果只是想用公式解决，可以用　sum　函数，利用三维引用可以解决此问题　　

方法　3：Sub　DD（）　　　

For　i　=　1　To　Workbooks。Count　　　

'bookname　=　Workbooks（i）。Name　　　

'If　bookname　　〃name〃　Then　'可自行判断名称〃主控　Workbook〃不列入加总　　　

last　=　Workbooks（i）。Sheets。Count　'最后一页（亦可用　SHEETS　名称判断加总）　　　

sum1　=　sum1　＋　Workbooks（i）。Sheets（last）。Range（〃a1〃）　'A1：工资　　　

'End　If　　　

Next　i　　　

＇B1＇　=　sum1　　　

End　Sub　　



　　　　　　　　有两个表，表　1、表　2，其中的数据有相同的，如何比较出两个表中的相同的数据　　



解答：For　i=1　to　a（行数）　　　

For　j=1　to　b（列数）　　　

Da（i；j）=sheets（1）。cells（i；j）　　　

Db（i；j）=sheets（2）。cells（i；j）　　　

Next　j　　　

Next　i　　　

For　i=1　to　a（行数）　　　

For　j=1　to　b（列数）　　　

For　m=1　to　a（行数）　　　

For　n=1　to　b（列数）　　　

If　Da（i；j）=　Db（m；n）　then　　　

K=k＋1　　　

sheets（3）。cells（k；1）=　Da（i；j）　　　

end　if　　　

Next　n　　　

Next　m　　　

Next　j　　　

Next　i　　

或：用函数　vlookup　寻找即可。　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　393　　


…………………………………………………………Page　394……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　请问如何在窗体中播放动画　　



解答：Sub　动画　（）　　　

'先作个快取图案　　　

ActiveSheet。Shapes（〃AutoShape　1〃）。Select　　　

For　x　=　1　To　800　Step　0。5　　　

Selection。Left　=　x　　　

Next　　　

Selection。Left　=　1　　　

End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　在　Excel　中；如何用程控某一单元格不可编辑修改　　



解答：在　XP　中：　　　

Private　Sub　Workbook_Open（）　　　

ProtectSpecialRange　（〃A1〃）　　　

End　Sub　　　

Sub　ProtectSpecialRange（RangeAddress　As　String）　　　

On　Error　Resume　Next　　　

With　Sheet1　　　

。Cells。Locked　=　False　　　

。Range（RangeAddress）。Locked　=　True　　　

。Protection。AllowEditRanges。Add　Title：=〃区域　1〃；　Range：=Range（RangeAddress）　_　　　

；　Password：=〃pass〃　　　

。Protect　DrawingObjects：=True；　Contents：=True；　Scenarios：=True　　　

End　With　　　

End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　mandBars　的OnUpdate　事件　　



解答：'这类事件可预置：　　　

'1。插入类模块；并将其命名为　MyEventClass；键入：　　　

Public　WithEvents　mandBars　As　mandBars　　　

Private　Sub　mandBars_OnUpdate（）　　　

'建议该用事件来处理自定义的　mandBars　的变更；还要用在其它地方　　　

If　Sheet1。＇a2＇　=　0　Then　End　'设置退出开关；以免不停地〃OnUpdate〃　　　

Sheet1。＇a1＇　=　Now　　　

End　Sub　　　

'2。在　Sheet1　中键入：　　　

Dim　myClassModule　As　New　MyEventClass　　　

Private　Sub　Worksheet_SelectionChange（ByVal　Target　As　Range）　　　

＇a1＇。NumberFormatLocal　=　〃h：mm：ss；@〃'设定　A1　时间显示格式　　　

Set　myClassModule。mandBars　=　Application。mandBars　　　

End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　394　　


…………………………………………………………Page　395……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　多张工作表如何排序和查找　　



如果在一个文件　book　中有很多工作表，比如　150　个，每个都有自己　的名称，如果我想很快的　

找到我想要找的工作表，有没有什么方法？可以将工作表排序或查找吗？我们单位在做基本养　

老保险的工作，一个人一张表，要找到某个人很麻烦，希望高手帮忙，excel　有这方面的功能　

吗？　　

解答：做个索引表，插入超级链接来链接各表　　

或用宏：Sub　宏　1（）　　

Dim　myIndexSheet　As　Worksheet；　Sht　As　Worksheet；　a　As　Long　　

Set　myIndexSheet　=　Worksheets。Add　　

a　=　1　　

For　Each　Sht　In　Worksheets　　

a　=　a　＋　1　　

myIndexSheet。Cells（a；　〃A〃）。Value　=　Sht。Name　　

Sht。Hyperlinks。Add　myIndexSheet。Cells（a；　〃A〃）；　〃〃〃〃　&　Sht。Name　&　〃！A1〃〃〃〃〃　　

End　With　　

Next　Sht　　　

End　Sub　（不行）　　



　　　　　　　　　　　　　　　　　　　　　　　　将表格的外框线和框内线条设置永久有效的方法　　



将表格的外框线和框内线条设置为不同格式，但在打印时却无法将每一页的底部外框线自动设　

为和其它三条边线一致，每次都必须手工设置（那可是几十页哦！），而且如果换一台打印机的　

话就会前功尽弃，怎么能够做到一劳永逸？　　

解答：打印文件前试试运行以下的代码。打印后关闭文件时不要存盘，否则下次要把格式改回　

来就痛苦了。（当然你也可以另写代码来恢复原来的格式）：　　　

Sub　detectbreak（）　　　

mycolumn　=　Range（〃A1〃）。CurrentRegion。Columns。Count　　　

Set　myrange　=　Range（〃A1〃）。CurrentRegion　　　

For　Each　mycell　In　myrange　　　

Set　myrow　=　mycell。EntireRow　　　

If　myrow。PageBreak　=　xlNone　Then　　　

GoTo　Nex　　　

Else　　　

Set　　arow　　=　　Range（Cells（myrow。Offset（…1）。Row；　　1）；　　Cells（myrow。Offset（…1）。Row；　　

mycolumn））　　　

With　arow。Borders（xlEdgeBottom）　　　

。LineStyle　=　xlDouble　'把这一行改成自己喜欢的表线　　　

。Weight　=　xlThick　　　

。ColorIndex　=　xlAutomatic　　　

End　With　　　

End　If　　　

Nex：　Next　mycell　　　

End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　395　　


…………………………………………………………Page　396……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　在　VBA　中UBound　是什么意思　　



　解答：ACCESS，你准备用UBOUND　作什么呢？还是用　MS　自己说的：　　　

UBound　函数　　　

返回一个　Long　型数据，其值为指定的数组维可用的最大下标。　　　

语法　　　

UBound（arrayname＇；　dimension＇）　　　

UBound　函数的语法包含下面部分：　　　

部分　描述　　　

arrayname　必需的。数组变量的名称，遵循标准变量命名约定。　　　

dimension　可选的；Variant　（Long）。指定返回哪一维的上界。1　表示第一维，2　表示第二维，　

如此等等。如果省略　dimension，就认为是　1。　　　

说明　　　

UBound　函数与　LBound　函数一起使用，用来确定一个数组的大小。LBound　用来确定数组某一　

维的上界。　　　

对具有下述维数的数组而言，UBound　的返回值见下表：　　　

Dim　A（1　To　100；　0　To　3；　…3　To　4）　　　

语句　返回值　　　

UBound（A；　1）　100　　　

UBound（A；　2）　3　　　

UBound（A；　3）　4　　　

UBound　函数示例　　　

该示例使用　UBound　函数，确定数组的指定维的最大可用下标。　　　

Dim　Upper　　　

Dim　MyArray（1　To　10；　5　To　15；　10　To　20）　'声明数组变量。　　　

Dim　AnyArray（10）　　　

Upper　=　UBound（MyArray；　1）　'返回　10。　　　

Upper　=　UBound（MyArray；　3）　'返回　20。　　　

Upper　=　UBound（AnyArray）　'返回　10。　　　

LBound　函数　　　

返回一个　Long　型数据，其值为指定数组维可用的最小下标。　　　

语法　LBound（arrayname＇；　dimension＇）　　　

LBound　函数的语法包含下面部分：　　　

部分　描述　　　

arrayname　必需的。数组变量的名称，遵循标准的变量命名约定。　　　

dimension　可选的；Variant　（Long）。指定返回哪一维的下界。1　表示第一维，2　表示第二维，　

如此类推。如果省略　dimension，就认为是　1。　　　

说明　　　

LBound　函数与　UBound　函数一起使用，用来确定一个数组的大小。UBound　用来确定数组某一　

维的上界。　　　

对具有下述维数的数组而言，LBound　的返回值见下表：　　　

Dim　A（1　To　100；　0　To　3；　…3　To　4）　　　

语句　返回值　　　

LBound（A；　1）　1　　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　396　　


…………………………………………………………Page　397……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



LBound（A；　2）　0　　　

LBound（A；　3）　…3　　　

所有维的缺省下界都是　0　或　1，这取决于　Option　Base　语句的设置。使用　Array　函数创建　

的数组的下界为　0；它不受　Option　Base　的影响。　　　

对于那些在　Dim　中用　To　子句来设定维数的数组而言，Private、Public、ReDim　或　Static　语　

句可以用任何整数作为下界。　　　

LBound　函数示例　　　

该示例使用　LBound　函数来返回数组的指定维数的最小可用下标。可以使用　Option　Base　语　

句取代数组缺省下标值　0。　　　

Dim　Lower　　　

Dim　MyArray（1　To　10；　5　To　15；　10　To　20）　'声明数组变量