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

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



…………………………………………………………Page　404……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



。Size　=　12　　　

。Strikethrough　=　False　　　

。Superscript　=　False　　　

。Subscript　=　False　　　

。OutlineFont　=　False　　　

。Shadow　=　False　　　

。Underline　=　xlUnderlineStyleNone　　　

。ColorIndex　=　xlAutomatic　　　

End　With　　　

ActiveWindow。SelectedSheets。PrintOut　Copies：=1；　Collate：=True　　　

Loop　　　

End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　如何在同一储存格输入数值累计　　



如在　A1　输入　1，再次输　1=2，再次输　1=3，再次输　1=4。请问如何做到，我有发过帖子怎么不　

见了，请帮忙。　　

解答：'VBA：　　

Dim　A　As　Variant　　

Private　Sub　Worksheet_Change（ByVal　Target　As　Range）　　

　　　　On　Error　Resume　Next　　　

　　　　　If　Target。Cells（1；　　1）。Address　=　Range（〃A1〃）。Address　Then　　

　　　　　　　　Application。EnableEvents　=　False　　

　　　　　　　　　If　　＇A1＇　=　〃Reset〃　Or　　＇A1＇　=　〃〃　Then　　

　　　　　　　　　　　　　＇A1＇　=　〃〃　　

　　　　　　　　　　　　A　=　0　　

　　　　　　　　Else　　

　　　　　　　　　　　　A　=　A　＋　　1　　

　　　　　　　　　　　　　＇A1＇　=　A　　

　　　　　　　　End　　If　　

　　　　　　　　Application。EnableEvents　=　True　　

　　　　End　　If　　

End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　用单元格中的值来决定随机数是否随机　　



　　　　　是这样的，整个过程是：当　A1=0　时，随机数产生数据，等有一组我认为比较满意的数据　



时，我就用单元格　A1=1　来结束随机，如何实现，望帮助。　　



　　　　　解答　1　：　　



　　　　　Private　Sub　Worksheet_SelectionChange（ByVal　Target　As　Excel。Range）　　　



　　　　　if　range（〃A1〃）=0　then　　　



　　　　　产生随机数　　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　404　　


…………………………………………………………Page　405……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



　　　　　range（〃A1〃）=1　　　



　　　　　end　if　　　



　　　　　End　Sub　　　



　　　　　解答　2：建议用个按钮触发产生随机数据，点一次刷新一次　　　



　　　　　Sub　t（）　　　



　　　　　Dim　v　As　Integer　　　



　　　　　For　i　=　2　To　11　　　



　　　　　v　=　Int（（5　*　Rnd）　＋　1）　　　



　　　　　Cells（i；　1）　=　v　　　



　　　　　Next　　　



　　　　　End　Sub　　　



　　　　　解答　3：是这样的：我有无数的随机数，是由　rand（）产生的，（这是以前输的，我不想　



去重输这么多）这是前提。　　　



　　　　　当我获得一组合适的值的时候，我就在　A1　格内输入　1，从而使随机数固定在那组满意的　



值。下一组时，我在　A1　格输入　0。就是这样。　　



　　　　　解答　4：可不可以把满意的那组贴成数值到新表？当然是用　vba　来实现的。　　　



　　　　　Sub　g（）　　　



　　　　　Sheets（1）。UsedRange。Copy　　　



　　　　　Worksheets。Add　after：=Worksheets（Worksheets。Count）　　　



　　　　　Sheets（Worksheets。Count）。Cells（1；　1）。Select　　　



　　　　　Selection。PasteSpecial　Paste：=xlvalues　　　



　　　　　Sheets（1）。Cells（1；　1）　=　1　　　



　　　　　End　Sub　　　



　　　　　解答　5：　　　



　　　　　Private　Sub　mandButton1_Click（）　　　



　　　　　Dim　a；　b　As　Integer　　　



　　　　　For　a　=　1　To　2　'产生第一次随机数　　　



　　　　　For　b　=　1　To　3　　　



　　　　　Cells（a；　b）　=　Int（（8　*　Rnd）　＋　1）　　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　405　　


…………………………………………………………Page　406……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



Next　b　　　



Next　a　　　



Dim　c　As　Integer　　　



For　c　=　1　To　10　’询问是否对随机数满意　　　



If　（MsgBox（〃did　u　think　the　random　are　ok？〃；　260））　=　vbYes　Then　　　



Cells（3；　1）　=　1　'如果需要一个　0　或　1　的单元格给其它程序块使用　　　



Exit　Sub　'满意就退出　　　



Else　'不满意就继续产生随机数　　　



For　a　=　1　To　2　　　



For　b　=　1　To　3　　　



Cells（a；　b）　=　Int（（8　*　Rnd）　＋　1）　　　



Next　b　　　



Next　a　　　



Cells（3；　1）　=　0　　　



End　If　　　



Next　c　　　



MsgBox　〃if　u　want　to　continue　rondom　number　press　cmd1　again　please〃　　　



End　Sub　　



解答　6　简化一下：　　



Sub　test（）　　



Upper　=　0　　



Bottom　=　100　　



Do　While　Range（〃A1〃）　　1　　



Range（〃E1〃）　=　Int（Rnd（）　*　（Upper　Bottom　＋　1））　＋　Bottom　　



Response　=　MsgBox（〃Do　you　accept　the　number？〃；　vbYesNo　＋　vbDefaultButton2）　　



If　Response　=　vbYes　Then　Range（〃A1〃）　=　1　　



Loop　　



End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　406　　


…………………………………………………………Page　407……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　排列组合　　



比如现在有一个　长度是　9　位的字符串　（ABCDEFGHI），想列出全部的只取其中　7个字符的组合值：　　

CDEFGHI、ADEFGHI、ABEFGHI、ABCFGHI、ABCDGHI、〃〃、共　36　个。用函数或　VBA　均可。　　

解答：Sub　bination（）　　

　　　　Dim　a；　b；　c；　d；　e；　f；　g；　h；　　i；　j；　k　As　　Integer　　

　　　　Dim　str　As　String　　

　　　　j=1　　

　　　　For　a　=　0　To　　1　　

　　　　　　　　For　b　=　0　To　2　Step　2　　

　　　　　　　　　　　　For　c　=　0　To　3　Step　3　　

　　　　　　　　　　　　　　　　For　d　=　0　To　4　Step　4　　

　　　　　　　　　　　　　　　　　　　　For　e　=　0　To　5　Step　5　　

　　　　　　　　　　　　　　　　　　　　　　　　For　f　=　0　To　6　Step　6　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　For　g　=　0　To　7　Step　7　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　For　h　=　0　To　8　Step　8　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　For　　i　=　0　To　9　Step　9　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　k　=　a　/　　1　＋　b　/　2　＋　c　/　3　＋　d　/　4　＋　e　/　5　＋　f　/　6　＋　g　/　7　＋　h　/　8　＋　　i　/　9　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　If　k　=　7　Then　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　str　=　〃〃　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　If　a　　0　Then　str　=　str　&　〃A〃　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　If　b　　0　Then　str　=　str　&　〃B〃　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　If　c　　0　Then　str　=　str　&　〃C〃　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　If　d　　0　Then　str　=　str　&　〃D〃　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　If　e　　0　Then　str　=　str　&　〃E〃　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　If　f　　0　Then　str　=　str　&　〃F〃　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　If　g　　0　Then　str　=　str　&　〃G〃　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　If　h　　0　Then　str　=　str　&　〃H〃　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　If　　i　　0　Then　str　=　str　&　〃I〃　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　cells（j；1）=str　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　j=j＋1　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　End　　If　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　Next　　i　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　Next　h　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　Next　g　　

　　　　　　　　　　　　　　　　　　　　　　　　Next　f　　

　　　　　　　　　　　　　　　　　　　　Next　e　　

　　　　　　　　　　　　　　　　Next　d　　

　　　　　　　　　　　　Next　c　　

　　　　　　　　Next　b　　

　　　　Next　a　　

End　Sub　　　

如用　MID　函数，修改一下以上程序可得到任意长度为　9　的字符串的任取　7　个字符的组合。　　

解答　2：用公式的解：　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　407　　


…………………………………………………………Page　408……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



=REPLACE（REPLACE（M1；MIN（IF（ROW（）　4　Then　　　

。Value　=　〃〃　　　

GoTo　ex　　　

End　If　　　

If　Trim（Target）　=　〃〃　Then　　　

If　Trim（。Offset（1；　0））　=　〃〃　Then　　　

If　。Row　=　5　Then　　　

。Offset（…1；　0）　=　〃〃　　　

ElseIf　。Row　》　5　Then　　　

。Offset（…1；　0）　=　〃=SUM（〃　&　。Offset（…1；　0）。End（xlUp）。Address（False；　False；　xlA1）　&　〃：〃　　

&　。Offset（…2；　0）。Address（False；　False；　xlA1）　&　〃）〃　　　

End　If　　　

End　If　　　

If　。Offset（1；　0）。HasFormula　And　。Row　=　4　Then　。Offset（1；　0）　=　〃〃　　　

If　Trim（。Offset（1；　0））　　〃〃　Then　　　

。Delete　Shift：=xlUp　　　

Cells（1；　ActiveCell。Column）　=　Cells（1；　ActiveCell。Column）　1　　　

End　If　　　

ElseIf　Trim（。Offset（1；　0））　=　〃〃　Or　。Offset（1；　0）。HasFormula　Then　　　

。Offset（1；　0）　=　〃=SUM（〃　&　。End（xlUp）。Address（False；　False；　xlA1）　&　〃：〃　　

&　。Address（False；　False；　xlA1）　&　〃）〃　　　

Cells（1；　。Column）　=　Cells（1；　。Column）　＋　1　　　

End　If　　　

End　With　　　

ex：　　　

Application。EnableEvents　=　True　　　

End　Sub　　　

Private　Sub　Worksheet_SelectionChange（ByVal　Target　As　Range）　　　

With　Target　　　

If　。Rows。Count　》　1　Or　。Columns。Count　》　1　Then　ActiveCell。Select　　　

If　。Row　《　3　And　。Column　《　5　Then　Cells（4；　ActiveCell。Column）。Select　　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　408　　


…………………………………………………………Page　409……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



End　With　　　

End　Sub　　　

以上代码是按我理想的做的。　　　

主要部分：　　　

If　Trim（。Offset（1；　0））　=　〃〃　Or　。Offset（1；　0）。HasFormula　Then　　　

。Offset（1；　0）　=　〃=SUM（〃　&　。End（xlUp）。Address（False；　False；　xlA1）　&　〃：〃　　

&　。Address（False；　False；　xlA1）　&　〃）〃　　　

Cells（1；　。Column）　=　Cells（1；　。Column）　＋　1　　　

End　If　　　

没有注释，将就看吧！　　　

dick　小修改。。。　　　

Private　Sub　Worksheet_Change（ByVal　Target　As　Range）　　　

Application。EnableEvents　=　False　'触发设　False　　　

R　=　Target。Row　　　

C　=　Target。Column　　　

A　=　Range（〃A65536〃）。End（xlUp）。Offset（0）。Row　'最后一笔　　　

If　C　=　1　Then　'最后一笔　　　

If　R　=　A　Then　　　

ALL　=　Application。WorksheetFunction。Sum（Range（Cells（1；　1）；　Cells（R；　1）））　'sum　　　

Target。Offset（1）　=　ALL　'最后一笔＋1；放　sum　值　　　

Else　　　

ALL　=　Application。WorksheetFunction。Sum（Range（Cells（1；　1）；　Cells（A　1；　1）））　'sum　　　

Cells（A；　1）　=　ALL　'更动；重新计算　　　

End　If　　　

End　If　　　

Application。EnableEvents　=　True　''触发设　True　　　

End　Sub　　　

更正　　　

If　C　=　1　Then　'A　栏　　　

If　R　=　A　Then　'最后一笔　　　

tof　　　

翻阅了一些书；知道　VBA　向单元格输入公式是以文本格式输入的。　　　

受到启发只要使用　RC　形式；将移动数字作为变量；　连接文本输入就可以达到目的了；　　　

现使用循环激活达到〃〃的单元格的行　　　

I2　=　2　　　

LINE3：　　　

If　Cells（I2；　h）　=　〃〃　Then　　　

Else　　　

I2　=　I2　＋　1　　　

GoTo　LINE3：　　　

End　If　　　

Cells（I2；　h　＋　1）。Formula　=　〃=SUM（R＇〃　&　I2　&　〃＇C：R＇…1＇C）〃　　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　409　　


…………………………………………………………Page　410……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　关于使用　VBA　复制的问题　　



问题：我有一个表格，如何将其原封不动的在同一表单如　SHEET1　中复制多份，要求它们完全一　

样。我用宏录制完后，总是对最后选定的单元格进行修改，很不方便。　　　

如　A1：C6　是一个小表，我在　A7　位置按快捷键生成一张，到　A15　按快捷键又生成一张，而不必　

在宏中将　A7　改为　A15。　　　

解答：　ACCESS　　　

建立下面宏时，先建立一快捷键　　　

Sub　cy（）　　　

Sheets（〃sheet1〃）。Range（〃A1：C6〃）。Copy　　　

ActiveSheet。Paste　　　

Range（〃A1〃）。Se