VBA知识 VBA知识 系统控制（标
题
快递公司问题件快递公司问题件货款处理关于圆的周长面积重点题型关于解方程组的题及答案关于南海问题
4） 打开本地文档 在 Microsoft Excel 用VBA，可使用 Open 方法开启HTML 文件。 Workbooks.Open Filename:="C:\*.htm" 如何打开网站（chijanzen超级版主） 1、temp = "C:\Program Files\Internet Explorer\IEXPLORE.EXE http://hopfung.vicp.net/cgi-bin/ ... topic=48&show=0" Shell temp, 1 如何打开*.htm的文件？ 摘自帮助：1对应的是VB常量vbNormalFocus。 vbHide 0 窗口被隐藏，且焦点会移到隐式窗口。常数vbHide在Macintosh平台不可用。 VbNormalFocus 1 窗口具有焦点，且会还原到它原来的大小和位置。 VbMinimizedFocus 2 窗口会以一个具有焦点的图标来显示。 VbMaximizedFocus 3 窗口是一个具有焦点的最大化窗口。 VbNormalNoFocus 4 窗口会被还原到最近使用的大小和位置，而当前活动的窗口仍然保持活动。 VbMinimizedNoFocus 6 窗口会以一个图标来显示。而当前活动的的窗口仍然保持活动。 2、Sub IE()'打开个人网页 ActiveWorkbook.FollowHyperlink "about:blank" SendKeys "{F4}ykk1976.anyp.cn{ENTER}", True End Sub 保存所有打开的工作簿，然后退出 Microsoft Excel。 For Each w In Application.Workbooks w.Save Next w Application.Quit 将selection写入text file 这样处理的确是不行了，通常做法有二：1、通过循环，一句一句将选择的
内容
财务内部控制制度的内容财务内部控制制度的内容人员招聘与配置的内容项目成本控制的内容消防安全演练内容
写入到文本文件；2、控件剪贴板，将剪贴板的内容写入文件。 相对来讲，第一种方式编程方式简单，值得推荐，而第二种方式需要有较高的编程技巧，而且还得看VBA是否可以控制剪贴板。 TO 对面男孩 谢谢你，但是还是有问题 在工作
表
关于同志近三年现实表现材料材料类招标技术评分表图表与交易pdf视力表打印pdf用图表说话 pdf
中选中三行三列的数据后，复制，在记事本中粘贴，得到 11 22 33 13 23 33 15 25 35 而运行程序却得到 11 22 33 13 23 33 15 25 35 我希望的结果是和用手工复制粘贴一样的格式，怎么办啊？ 這是你想要的（chijanzen超级版主） Dim rRange As Range Set rRange = Selection.Cells Set rObj = CreateObject("scripting.filesystemobject") Set TxtFile = rObj.createtextfile("C:\VBA程式\abc.txt") For i = 1 To rRange.Rows.Count For j = 1 To rRange.Columns.Count TxtFile.Write rRange.Cells(i, j) TxtFile.Write " " Next j TxtFile.WriteBlankLines 1 Next i TxtFile.Close 如何读写Oracle数据库 1、 配置Oracle客户端 我是在局域网上用的，配置好并测试通过，例如：Net服务器名称叫 Hrms 2.1 代码1 Sub 提取一个单位
报表
企业所得税申报表下载财务会计报表下载斯维尔报表下载外贸周报表下载关联申报表下载
数据() Set cnn = New ADODB.Connection strCnn = "Provider=MSDAORA.1;" & "Data Source= HRMS ;User Id= HAHA ;Password= HEHE" cnn.Open strCnn Call 提取报表数据 Call 复制数据 cnn.Close Worksheets(1).Unprotect MsgBox "古今多少事，都付笑谈中", , "哈哈哈哈哈..." End Sub Sub 提取报表数据() Dim mySheets As Worksheets Dim strUnitCode As String Dim strSQL As String Dim iQSL As Integer Dim strDBName As String Dim strDBUserNamePass As String Dim InputData Dim aInputData() As String Dim aYXInputData() As String '有效数组 Dim rst As New ADODB.Recordset '提取人员报表2张 strRepCodeJ = Array("000015", "000485") Worksheets(2).Activate For i = 0 To 10 strSQL = "select * from rep_data_detail where unitcode='" & Sheet1.strDWM & "' and repcode =" & strRepCodeJ(i) & "and RepDate=" & ThisWorkbook.RepDate rst.Open strSQL, cnn Worksheets(2).Cells(i * 100 + 1, 1).CopyFromRecordset rst rst.Close Next End Sub 2.2代码2 数值 变量的定义和使用 等 级 关键字 使用范围 项目级变量（Global Leevel） Public 适用于所有模块 模块级变量（Module Level） Dim,Private 只适用于本模块的所有过程 过程级变量（Local Level） Dim,Static 只在本过程中有效 注意：全局变量应在模块顶部的声明段中加以声明。而模块变量在模块顶部的声明段中声明。局部变量在过程顶部声明即可。 举例说明：1、比如Public 的使用 首先在模块的顶部进行定义，在其他模块中使用时，要在变量名称前加上引用定义模块的名称，在sheet1中定义的，其他模块中使用时，Sheet1.strDW 如何定义数组变量 例1 dim test(10) as integer option base(1) 例2 dim arr(1 to 10, 1 to 2) 默认情况下，数组类型为Long数据类型的数字，数组索引值为0。as 定义数据类型，option base(1)定义数组索引值为1。 如何定义动态数组变量 ReDim 语句示例 该示例使用 ReDim 语句为动态数组变量分配和重分配存储空间。假设 Option Base 是 1。 Dim MyArray() As Integer '声明动态数组。 Redim MyArray(5) '分配 5 个元素。 For I = 1 To 5 '循环 5 次。 MyArray(I) = I '初始化数组。 Next I 下一条语句重定义该数组的大小，并清除其中的元素。 Redim MyArray(10) '大小重定为 10 个元素。 For I = 1 To 10 '循环 10 次。 MyArray(I) = I '初始化数组。 Next I 下面的语句重定义该数组的大小，但没有清除其中的元素。 Redim Preserve MyArray(15) '大小重定为 15 个元素。 单元格、单元区域 选取连续数据区域 方法1：[D5].CurrentRegion.Select 方法2：Range(Cells(1, iJCBXMColumn), Cells(50, iJCBXMColumn)) 活动、指定单元格所在行B列单元格中的值 1、Sheet1.cells(activecell.row,"B").value 2、Sheet1.Cells(myRange.Row, "B").Value 有条件求和 对B列B5到B列的最后中不是红色字体的单元格数值求和 方法∶ Sub aa() For Each dd In Range("b5:b65536") If dd.Font.ColorIndex <> 3 Then total1 = total1 + dd.Value Next MsgBox total1 End Sub 最后1行行数 方法1： iLastRow1 = DBXXSheet.Range("A65536").End(xlUp).Row 最后1列列数 方法1： iLastColumn = DBXXSheet.Range("IV1").End(xlToLeft).Column 动态设置列 GBXXSheet.Columns (iGBXXKeyColumn) 动态设置任意区域 1、 Private Sub ScrollBar1_Change() Dim a As Range Set YHJMSheet = Sheets("用户界面") Set a = Sheet2.Range("Q643") On Error Resume Next YHJMSheet.Unprotect With Application .ScreenUpdating = False .EnableEvents = False Range(Cells(6, 4), Cells(6, 4)).EntireRow.Hidden = True Range(Cells(a, 4), Cells(a + 21, 4)).EntireRow.Hidden = False Range(Cells(6, 4), Cells(a, 4)).EntireRow.Hidden = True Range(Cells(a + 21, 4), Cells(643, 4)).EntireRow.Hidden = True ' [H492] = "=SUM(R" & a + 1 & "C:R" & a + 8 & "C)" ' [I492] = "=SUM(R" & a + 1 & "C:R" & a + 8 & "C)" .ScreenUpdating = True .EnableEvents = True End With YHJMSheet.Protect End Sub 2、但是With GBXXSheet. Application .Range(Cells(intColumn, 1), Cells(intColumn, 65536)) 可以运行，但运行结果却非我所要？？ 3、 strZSJ2 = num2letter(intZCZL) & "2" strZSJ65536 = num2letter(intZCZL) & "65536" For Each myRange In Sheet1.Range(strZSJ2, strZSJ65536) If myRange = Empty Then MsgBox "工作数据处理完毕！", vbInformation, "系统提示" Exit Sub End If '数据对比 。。。。。。。 Next myRange num2letter参见本表中自定义函数：根据数字返回对应的字母列号 计算区域内非空单元的个数 方法1： Sub test() MsgBox Application.WorksheetFunction.CountA(Columns(1)) ‘取得第一列的非空单元格数 End Sub 方法2： 函数: COUNTA(B:B) 查找指定区域数值的行列位置 1、方法一 With Sheet3.Range("B1:B53") '指定查找区域 Set c = .Find(sName, LookAt:=xlWhole) If c Is Nothing Then MsgBox sName, , "查无此人！" Else FieldNameAddress = c.Address iNameRow = Sheet3.Range(FieldNameAddress).Row '查找姓名在‘评委打分表’中的行位 MsgBox iNameRow, , "哈哈" End If End With 2、方法二 FindRow = Sheet2.Range("D:D").Find(What:=myRange.Value, LookIn:=xlValues).Row If Sheet2.Columns(intCCZL).Find(What:=myRange.Value, LookIn:=xlValues) Is Nothing Then FindRow = myRange.Row 将一个表中的一行全部拷贝到另一个表中 Sheet2.Rows(1).Value = Sheet1.Rows(1).Value 把B1到B12单元格的数据填入c1到c12 Sub aa() For i = 1 To 12 Range("C" & i) = Range("B" & i) Next i End Sub 将A1到C6中大于=3的数依次放入E列 Private Sub CommandButton1_Click()' Dim i As Long r = 1 For Each i In Range("a1:c6") If i > =3 Then Cells(r, 5) = i: r = r + 1 Next End Sub 关于保存工作表的问题？ 一个工作薄中有工作表1-日报表、工作表2-数据表、工作表3-统计表，在每天做完报表后进行保存提交，日报表保存路径为C:\My Documents\日报表\yyyy-m-d日报；数据表保存路径为C:\My Documents\数据表\yyyy-m-d数据；统计表保存路径为C:\My Documents\统计表\yyyy-m-d统计。或者为日报表保存路径为C:\My Documents\日报表\年-月-日-次数；数据表保存路径为C:\My Documents\数据表\年-月-日-次数；统计表保存路径为C:\My Documents\统计表\年-月-日-次数。不知道我讲述的是否清楚。 請先確認工作薄中只有三個工作表"工作表1-日报表、工作表2-数据表、工作表3-统计表" 程式中日报表保存路径为C:\My Documents\日报表\日报 年-月-日-次数 数据表保存路径为C:\My Documents\数据表\数据 年-月-日-次数 统计表保存路径为C:\My Documents\统计表\统计 年-月-日-次数 其中次數會自動增加流水號(同一天一個檔存很多次時) 附檔內程式碼為繁體 Dim Temp_WorkName As Object Dim fs As Object, fc As Object Dim Temp_ShtName As String, Temp_Date As String Dim tmp_name1 As String r = 1 Set Temp_WorkName = ThisWorkbook Temp_Path = "C:\temp\" For Each sht In Sheets Temp_ShtName = sht.Name Temp_ShtSortName = Left(Temp_ShtName, Len(Temp_ShtName) - 1) Temp_Date = Format(Date, "[$-404]e-m-d;@") & "-" & r tmp_name1 = Temp_Path & Temp_ShtName & "\" & Temp_ShtSortName & Temp_Date Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(Temp_Path & "\" & Temp_ShtName) Set fc = f.Files For Each Item In fc D_filename = Left(Item, Len(Item) - 4) If D_filename = tmp_name1 Then '檔名相同時,次數+1 r = r + 1 Temp_Date = Format(Date, "[$-404]e-m-d;@") & "-" & r tmp_name1 = Temp_Path & Temp_ShtName & "\" & Temp_ShtSortName & Temp_Date End If Next Workbooks.Add.SaveAs Filename:=tmp_name1 Temp_CopyWorkName = ActiveWorkbook.Name Temp_WorkName.Sheets(Temp_ShtName).Cells.Copy Cells.Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Workbooks(Temp_CopyWorkName).Close SaveChanges:=True Next sht End sub 关于保存工作表的问题（例程） 怎样用MSGBOX来在对话框内加入一个超级链接？(井底之蛙-Emily) 如题 本贴包含图片附件: Message Box 不可以吧！ 不如參考這個 UserForm 式的例子—— ——————例程———————— 原本的 HyperLink 不大好，現更改如下回文。 [ 本贴由 Emily 于 2002-12-27 21:51 最后编辑 ] 那么你的意思就是说，他那个提示框中的叹号也是一个图片，然后再把文字和按钮排列得象是一个由MSGBOX形成的窗体。是这个意思吧？其他的语言如VC、DELPHI、PB也不可以吗？ 如附圖，是否相似。 本贴包含图片附件: 单元格和单元区域 当选中“A1”单元格中，而且发生改变时，Then……（Emily） Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then ...... End If End Sub 区域改变、内容改变（对面男孩） 一个选择区域的改变（Worksheet_SelectionChange)，一个是内容的改变(Worksheet_Change). 如何使VBA自动消除使用COPY复制后产生的虚线框？ 我经常用VBA自动判断，符合条件的自动复制到另一张工作表，可是复制后会在源表选择区产生一个虚线框，很着痕迹，有什么办法消除？ Application.CutCopyMode = False VBA中插入问题－－行中有合并单元格时插入列宏记录与实际运行不一致？ 我在VAB中用宏记录了一段插入，第一行是合并的单元格。 宏记录如下： Columns("G:G").Select Range("G4").Activate Selection.insert Shift:=xlToRight 在原记录时是在表中插入了一列，但实际运行时却插入了合并单元格的跨列数。 不知何故？请大侠指教！ 第 2 帖 blue 大概了解你的意思,下列程式碼可達成需求 如果不行,請指教 Sub MergeCell() If ActiveCell.MergeCells Then Ars = ActiveCell.EntireColumn.Address Columns(Ars).Insert Shift:=xlToRight Else ActiveCell.Insert Shift:=xlToRight End If 锁定单元格区域 1、菜单操作 在菜单 工具——保护——允许用户编辑区域 中选中允许用户编辑的区域，然后在菜单中 工具——保护——保护工作表。这样就只能在设定可编辑区域进行编辑操作。 2、ScrollArea 属性 参阅应用于示例特性以 A1 样式的区域引用形式返回或设置允许滚动的区域。用户不能选定滚动区域之外的单元格。String 类型，可读写。 说明 可将本属性设置为空字符串 ("") 以允许对整张工作表内所有单元格的选定。 示例 本示例设置第一张工作表的滚动区域A1：F10。 Worksheets(1).ScrollArea = "a1:f10" if application.max([a1:e1])=10 then msgbox"" Worksheets(1).ScrollArea = "" Endif 'A1—E1最大的数值达到10时，自动弹出对话框，并解锁单元格 在单元格中设置公式 [a1].formula="=b1+c1"'A1中设定公式为=B1+C1 典型的动态改变单元格公式的例子，在vba中经常用到 用变量如何简写以下代码? 下列代码是以30为单位递增的.我想把公式写入b列相应的单元格内.如果只写B列的话不知用定义变量的方法如何写。我还有C、D、F列也是写入一样的公式如果把B、C、D、F写在一起用变量的方法又怎样写。谢谢! Sheet1.Range("b89") = "=COUNTA(b60:b88)" Sheet1.Range("b119") = "=COUNTA(b90:b118)" Sheet1.Range("b149") = "=COUNTA(b120:b148)" . . . . Sheet1.Range("b6869") = "=COUNTA(b6840:b6868)" 可以实现 建立以下的宏，运行没有问题。 Sub 宏1() Dim S1, S2 As String Dim Temp, Left, Right As Integer For m = 89 To 6869 Temp = m Left = m - 29 Right = m - 1 S1 = "b" & m S2 = "=COUNTA(b" & Left & ":b" & Right & ")" Sheet1.Range(S1) = S2 m = m + 30 Next m End Sub 有其他列，可以将b设置为string变量，每次自动获取或手工编写。 返回指定列数的列标 'pureNum为1-256之间的整数 Public Function NumToChr(PureNum As Integer) As String If PureNum Mod 26 = 0 Then NumToChr = VBA.IIf(PureNum \ 26 = 1, "", VBA.Chr(PureNum \ 26 + 63)) & "Z" Else If PureNum <= 256 Then NumToChr = VBA.IIf(PureNum \ 26 = 0, "", Chr(PureNum \ 26 + 64)) & Chr(PureNum Mod 26 + 64) Else NumToChr = "超出范围" MsgBox "当前EXCEL版本只有256列,你输入的列数不存在.请在1-256之间选取数字" End If End If End Function 取得硬盘中某个路径下另外一个excel表的某个单元格的值 假如另一个文件在d盘下文件名为1.xls,要得到的数据为sheet1表的a1单元格 ='D:\[1.xls]Sheet1'!$A$1 类型转换函数 每个函数都可以强制将一个表达式转换成某种特定数据类型。 语法 CBool(expression) CByte(expression) CCur(expression) CDate(expression) CDbl(expression) CDec(expression) CInt(expression) CLng(expression) CSng(expression) CStr(expression) CVar(expression) CStr(expression) 必要的 expression
参数
转速和进给参数表a氧化沟运行参数高温蒸汽处理医疗废物pid参数自整定算法口腔医院集中消毒供应
可以是任何字符串表达式或数值表达式。 返回类型 函数名称决定返回类型，如下所示： 函数 返回类型 expression 参数范围 CBool Boolean 任何有效的字符串或数值表达式。 CByte Byte 0 至 255。 CCur Currency -922,337,203,685,477.5808 至922,337,203,685,477.5807。 CDate Date 任何有效的日期表达式。 CDbl Double 负数从 -1.79769313486231E308 至 -4.94065645841247E-324；正数从 4.94065645841247E-324 至 1.79769313486232E308。 CDec Decimal 零变比数值，即无小数位数值，为 +/-79,228,162,514,264,337,593,543,950,335。对于 28 位小数的数值，范围则为 +/-7.9228162514264337593543950335；最小的可能非零值是 0.0000000000000000000000000001。 CInt Integer -32,768 至 32,767，小数部分四舍五入。 CLng Long -2,147,483,648 至 2,147,483,647，小数部分四舍五入。 CSng Single 负数为 -3.402823E38 至 -1.401298E-45；正数为 1.401298E-45 至 3.402823E38。 CStr String 依据 expression 参数返回 Cstr。 CVar Variant 若为数值，则范围与 Double 相同；若不为数值，则范围与 String 相同。 说明 如果传递给函数的 expression 超过转换目标数据类型的范围，将发生错误。 通常，在编码时可以使用数据类型转换函数，来体现某些操作的结果应该表示为特定的数据类型，而不是缺省的数据类型。例如，当单精度、双精度或整数运算发生的情况下，使用 CCur 来强制执行货币运算。 应该使用数据类型转换函数来代替 Val，以使国际版的数据转换可以从一种数据类型转换为另一种。例如，当使用 Ccur 时，不同的小数点分隔符、千分位分隔符和各种货币选项，依据系统的区域设置都会被妥善识别。 当小数部分恰好为 0.5 时，Cint 和 CLng 函数会将它转换为最接近的偶数值。例如，0.5 转换为 0、1.5 转换为 2。Cint 和 CLng 函数不同于 Fix 和 Int 函数，Fix 和 Int 函数会将小数部分截断而不是四舍五入。并且 Fix 和 Int 函数总是返回与传入的数据类型相同的值。 使用 IsDate 函数，可判断 date 是否可以被转换为日期或时间。Cdate 可用来识别日期文字和时间文字，以及落入可接受的日期范围内的数值。当转换一个数字成为日期时，是将整数部分转换为日期，小数部分转换为从午夜起算的时间。 CDate 依据系统上的区域设置来决定日期的格式。如果提供的格式为不可识别的日期设置，则不能正确判断年、月、日的顺序。另外，长日期格式，若包含有星期的字符串，也不能被识别。 CVDate 函数也提供对早期 Visual Basic 版本的兼容性。CVDate 函数的语法与 CDate 函数是完全相同的，不过，CVDate 是返回一个 Variant，它的子类型是 Date，而不是实际的 Date 类型。因为现在已有真正的 Date 类型，所以 CVDate 也不再需要了。转换一个表达式成为 Date，再赋值给一个 Variant，也可以达到同样的效果。也可以使用这种技巧将其他真正的数据类型转换为对等的 Variant 子类型。 注意 CDec 函数不能返回独立的数据类型，而总是返回一个 Variant，它的值已经被转换为 Decimal 子类型。 关于批注 1、自动调整批注(comment)的大小 [Copy to clipboard] CODE: Sub Comments_AutoSize() Dim MyComments As Comment For Each MyComments In ActiveSheet.Comments With MyComments .Shape.TextFrame.AutoSize = True End With Next End Sub 2、调整批注内容的格式？如字体大小、颜色 [Copy to clipboard] CODE: Sub Comments_FontSet() Dim MyComments As Comment For Each MyComments In ActiveSheet.Comments With MyComments.Shape.TextFrame.Characters.Font .ColorIndex = 5 .Size = 11 .Bold = True .Name = "Times New Romen" End With Next End Sub 3、如果是将单元格的内容填写到批注里,可以这样写 [Copy to clipboard] CODE: Sub Comments_AutoAdd() Dim Rng As Range Dim MyComments As Comment On Error Resume Next For Each Rng In ActiveSheet.UsedRange Rng.Comment.Delete Set MyComments = Rng.AddComment(Text:=Rng.Value) Next End Sub 4、复制---选择性粘贴---批注 5、读取批注 读取批注并计算两时间之间年数的问题？ 在此工作表的A任一单元格双击，就会产生一个日期批注。如果电脑系统日期和A列相应行单元格作比较，电脑系统日期大于A列相应行单元格日期两年以上，就在C列对应的单元格作出提示“过期”。（请看附件） 另：excelhome来生缘老师关于读取批注的正确代码： Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim msg On Error Resume Next If Target.Column = 1 And Target.Row <> 1 Then msg = MsgBox("是否添加批注？", vbOKCancel, "注意") If msg = vbOK Then Target.AddComment Target.Comment.Text Text:=Chr(10) & Date Else Exit Sub End If End If If Target.Column = 2 And Not Target.Offset(0, -1).Comment Is Nothing Then Target.Value = Target.Offset(0, -1).Comment.Text End If End Sub 工作表、工作簿 定位工作表 程序中根据指定的数字定位工作表sheet intR1，intC1区域的起始单元格位置 intR2，intC2区域的终止单元格位置 Function 取列位置(strName As String, intMySheet As Integer, intR1 As Integer, intC1 As Integer, intR2 As Integer, intC2 As Integer) As Integer Dim strWZ1 As String Dim strWZ2 As String Dim MySheet As Worksheets strWZ1 = num2letter(intC1) & Trim(Str(intR1)) strWZ2 = num2letter(intC2) & Trim(Str(intR2)) With Worksheets(intMySheet).Range(strWZ1, strWZ2) '指定查找区域 ' With MySheet(intMySheet).Range(strWZ1, strWZ2) '指定查找区域 Set c = .Find(strName, LookAt:=xlWhole) If c Is Nothing Then 取列位置 = "" Else FieldNameAddress = c.Address 取列位置 = Worksheets(intMySheet).Range(FieldNameAddress).Column End If End With End Function 取得工作表名称 方法1、取得活动工作表名称 Msgbox ActiveSheet.Name 方法2 =REPLACE(CELL("filename",INDIRECT("A1")),1,FIND("]",CELL("filename",INDIRECT("A1"))),) 方法3 返回工作表名的函数有很多种写法，因为用Cell("fielname")函数文件必须先保存，公式才能返回正确结果，否则返回错误值，所以一般都用宏表函数，给你一个宏表函数。 Name=SUBSTITUTE(GET.DOCUMENT(1),"["&GET.DOCUMENT(88)&"]",) 单元格=Name 引用工作表名称 1、应用 Worksheets(strSHBM).Range(strSHWZ1).Row 2、应用：根据选择自动跳转到相应工作表 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$2" Then Worksheets(Target.Value).Activate End Sub 做法：点击A2，然后,点击菜单栏下"数据"--"有效性",就可以录入工作表名称 把当前工作表复制到一个新的工作薄中! 把当前工作表复制到一个新的工作薄当中,新的工作薄最好除了复制过去的这一个工作表,没其它工作表的 方法1： 其实这个东西，你自己做宏记录就完全够用了。 Cells.Select Range("A1").Activate Selection.Copy Workbooks.Add ActiveSheet.Paste Application.CutCopyMode = False 保存新文件: chdir "你欲保存的路径" ActiveWorkbook.SaveAs Filename:="文件名.xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False 方法2： Sheets("Sheet1").Copy DisplayMsg = "如有不同，输入档案名 " CreateFile = InputBox(DisplayMsg, "储存档案", "D:\Book1.xls") ActiveWorkbook.SaveAs Filename:=CreateFile, FileFormat:=xlNormal, Password:="", _ WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False [ 本贴由 Emily 于 2002-12-29 21:25 最后编辑 ] 方法3： Quote: test 于 2002-12-29 09:22 PM 写道： 我只要求复制工作表这一代码就好了,至于保存,另有代码控制,谢谢大家了!! ActiveSheet.Copy Before:=Workbooks("Book1").Sheets(1) Workbooks("??????")可自行更改 如果是新增到新的Book则参考下列程式码 Sub CopySheet() Dim NewBook As Workbook Dim ActSht As Object Set ActSht = ThisWorkbook.ActiveSheet Set NewBook = Workbooks.Add ActSht.Copy Before:=NewBook.Sheets(1) End Sub [ 本贴由 chijanzen 于 2002-12-29 21:49 最后编辑 ] 不过你这个代码是复制到当前工作薄呀,我需要的是复制到新工作薄! Quote: test 于 2002-12-29 09:41 PM 写道： 谢谢chijanzen! 不过你这个代码是复制到当前工作薄呀,我需要的是复制到新工作薄! 如果是新增到新的Book则参考下列程式码 Sub CopySheet() Dim NewBook As Workbook Dim ActSht As Object Set ActSht = ThisWorkbook.ActiveSheet Set NewBook = Workbooks.Add ActSht.Copy Before:=NewBook.Sheets(1) End Sub 我需要当前复制的工作表复制过去新的工作表时不换名,还是用来原来的名字,谢谢 新开的工作薄不能没其它工作表在里面吗? 1.先回答第二个问题 新增的WorkBook最少需要一个Sheet,所以只要保留复制的Sheet可用以下程式码 Sub CopySheet() Dim NewBook As Workbook Dim ActSht As Object Set ActSht = ThisWorkbook.ActiveSheet Set NewBook = Workbooks.Add ActSht.Copy Before:=NewBook.Sheets(1) For Each sht In NewBook.Sheets If sht.Name <> ActSht.Name Then Application.DisplayAlerts = False sht.Delete Application.DisplayAlerts = True End If Next sht End Sub 2.我需要当前复制的工作表复制过去新的工作表时不换名,还是用来原来的名字,谢谢 要用原来的名字?那不就两个档名都一样了?是这样吗?档案的路径是否一样? 就是新开文件的时候,能不能从指定的范本中新开? 因为我需要用到范本精灵来管理数据,所以希望,新开的工作薄能从指定的范本中开启. Const Temp_Name = "C:\Program Files\Microsoft Office\Templates\1028\????.xlt" Set NewBook = Workbooks.Add(Template:=Temp_Name) Temp_Name :路径自行更改 使很多被隐藏的工作表一次性还原（显示出来） 用宏 Dim sht As Worksheet For Each sht In ActiveWorkbook.Sheets sht.Visible = True Next sht 检查并增加名称为“KK”的工作表 '如果当前工作薄中没有名为kk的工作表的话，就增加一张名为kk的工作表，并将其排在工作表从左至右顺序排列的最左边的位置，即排在第一的位置 Sub CheckSheet() Dim shtSheet As Worksheet For Each shtSheet In Sheets If shtSheet.Name = "KK" Then Exit Sub Next shtSheet Set shtSheet = Sheets.Add(Before:=Sheets(1)) shtSheet.Name = "KK" End Sub 将工作薄中的全部n张工作表都在sheet1中建上链接 Sub test2() Dim Pt As Range Dim i As Integer With Sheet1 Set Pt = .Range("a1") For i = 2 To ThisWorkbook.Worksheets.Count .Hyperlinks.Add Anchor:=Pt, Address:="", SubAddress:=Worksheets(i).Name & "!A1" Set Pt = Pt.Offset(1, 0) Next i End With End Sub 获得工作表的总数 Sub countsh() MsgBox Sheets.Count End Sub 一次性删除工作簿中所有工作表的背景 Sub delback()' For Each shtSheet In Sheets shtSheet.SetBackgroundPicture Filename:="" Next shtSheet End Sub 查询问题 VLOOKUP 使用问题 VLOOKUP 使用问题，例程1提问 VLOOKUP 使用问题，例程1回答 [求助]如何确定符合条件的单元格的具体位置 如何在指定范围中查找指定值的单元格的行、列号？ Find 方法 请参阅 应用于 示例 特性 应用于 WorksheetFunction 对象的 Find 方法。 在工作表中查找特定信息。 expression.Find(Arg1, Arg2, Arg3) expression 必需。该表达式返回一个 WorksheetFunction 对象。 Arg1 String 类型，必需。工作表名称。 Arg2 String 类型，必需。单元格区域名称。 Arg3 Variant 类型，可选。精确限制查询的参数名称。 应用于 Range 对象的 Find 方法。 在区域中查找特定信息，并返回 Range 对象，该对象代表用于查找信息的第一个单元格。如果未发现匹配单元格，就返回 Nothing。本方法不影响选定区域或活动单元格。 有关在 Visual Basic 中使用 Find 工作表函数的详细信息，请参阅在 Visual Basic 中使用工作表函数。 expression.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SerchFormat) expression 必需。该表达式返回一个 Range 对象。 What Variant 类型，必需。要搜索的数据。可为字符串或任意 Microsoft Excel 数据类型。 After Variant 类型，可选。表示搜索过程将从其之后开始进行的单元格。此单元格对应于从用户界面搜索时的活动单元格位置。值得注意的是，After 必须是区域中的单个单元格。请记住搜索是从该单元格之后开始的；直到本方法绕回到指定的单元格时，才对其进行搜索。如果未指定本参数，搜索将从区域的左上角单元格之后开始。 LookIn Variant 类型，可选。信息类型。 LookAt Variant 类型，可选。可为以下 XlLookAt 常量之一：xlWhole 或 xlPart。 SearchOrder Variant 类型，可选。可为以下 XlSearchOrder 常量之一：xlByRows 或 xlByColumns。 SearchDirection XlSearchDirection 类型，可选。搜索的方向。 XlSearchDirection 可为以下 XlSearchDirection 常量之一。 xlNext 默认值 xlPrevious MatchCase Variant 类型，可选。若为 True，则进行区分大小写的查找。默认值为 False。 MatchByte Variant 类型，可选。仅在选择或安装了双字节语言支持时使用。若为 True，则双字节字符仅匹配双字节字符。若为 False，则双字节字符可匹配其等价的单字节字符。 SearchFormat Variant 类型，可选。搜索的格式。 说明 每次使用本方法后，参数 LookIn、LookAt、SearchOrder 和 MatchByte 的设置将保存。如果下次调用本方法时不指定这些参数的值，就使用保存的值。设置这些参数将更改“查找和替换”对话框中的设置，如果您忽略参数，更改“查找和替换”对话框中的设置将更改使用的保存值。若要避免这种问题的出现，每次使用该方法时请明确设置这些参数。 可以使用 FindNext 和 FindPrevious 方法重复搜索。 当搜索到指定的搜索区域的末尾时，本方法将绕回到区域的开始继续搜索。发生绕转后，若要停止搜索，请保存第一个找到的单元格地址，然后依据该保存地址测试每个后续查找到的单元格地址。 若要进行更为复杂的模式匹配查找，请用 For Each...Next 语句和 Like 运算符。例如，下列代码在单元格区域 A1:C5 中搜索字体名称以“Cour”开始的单元格。当 Microsoft Excel 找到匹配单元格以后，就将其字体改为“Times New Roman”。 For Each c In [A1:C5] If c.Font.Name Like "Cour*" Then c.Font.Name = "Times New Roman" End If Next 示例 本示例在工作表的单元格区域 A1:A500 中查找包含值 2 的所有单元格，并将这些单元格的值更改为 5。 With Worksheets(1).Range("a1:a500")
浙公网安备 33021202002483