设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 请问这段代码哪里错了？
数据透视表40+个常用小技巧，让你一次学会！
12下一页
返回列表 发新帖
查看: 3676|回复: 19

[已解决]请问这段代码哪里错了？

[复制链接]
qjsu
发表于 2012-10-22 17:06 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
Sub 去除公式连接()
     Dim i As Integer
      
     Dim y As Integer
     Application.ScreenUpdating = False
     y = InputBox("请输入表格数量")
      For i = 2 To y + 1
      
     Sheets(i).Select
        
     Columns("A:M").Select
      Selection.Copy
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
      Application.CutCopyMode = False
      Columns("A:D").Select
      Range("D1").Activate
      Selection.Delete Shift:=xlToLeft
      Columns("J:K").Select
      Selection.Delete Shift:=xlToLeft
      Sheets(i).Copy
      
      ActiveWorkbook.SaveAs Application.ActiveWorkbook.PATH & "\" & Sheets("i").Name & ".xls"  '(工作表名称为文件名）
      ActiveWorkbook.Close
      Next
      Application.ScreenUpdating = True
End Sub
最佳答案
月排行榜 / 总排行榜
hwc2ycy
2012-10-22 18:09
本帖最后由 hwc2ycy 于 2012-10-22 18:11 编辑
  1. Sub 去除公式连接()
  2.     Dim i As Integer
  3.     Dim sFilename
  4.     Dim y As Integer
  5.     Application.ScreenUpdating = False
  6.     '关闭警告信息和对话框，默认情况下重名文件会被覆盖
  7.     Application.DisplayAlerts = False
  8.     ' 跳过错误
  9.     On Error Resume Next
  10.     '检测输入值是否合法
  11.     y = CInt(InputBox("请输入表格数量"))
  12.     If y > Worksheets.Count Or y = 0 Then
  13.         MsgBox "请输入正确的工作表数量" & "[<" & Worksheets.Count & "]"
  14.         Exit Sub
  15.     End If
  16.     For i = 2 To y + 1
  17.         Sheets(i).Select
  18.         sFilename = ThisWorkbook.Path & Application.PathSeparator & Sheets(i).Name & ".xls"
  19.         'sfilename= ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Sheets(i).Name & ".xls"
  20.         Columns("A:M").Select
  21.         Selection.Copy
  22.         Selection.PasteSpecial Paste:=xlPasteValues
  23.         Application.CutCopyMode = False
  24.         Columns("A:D").Select
  25.         Range("D1").Activate
  26.         Selection.Delete Shift:=xlToLeft
  27.         Columns("J:K").Select
  28.         Selection.Delete Shift:=xlToLeft
  29.         Sheets(i).Copy
  30.         
  31.         'ActiveWorkbook.SaveAs Application.ActiveWorkbook.Path & "" & Sheets("i").Name & ".xls"  '(工作表名称为文件名）
  32.          Debug.Print sFilename
  33.         ActiveWorkbook.SaveAs Filename:=sFilename, FileFormat:=xlExcel7
  34.         'ActiveWorkbook.Close True, Filename:=sFilename
  35.         ActiveWorkbook.Close
  36.     Next
  37.     Application.ScreenUpdating = True
  38.     Application.DisplayAlerts = True
  39. End Sub
复制代码
excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
qjsu
 楼主| 发表于 2012-10-22 17:13 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
主要是这句，上面的应该没有错
      Sheets(i).Copy
      
       ActiveWorkbook.SaveAs Application.ActiveWorkbook.PATH & "\" & Sheets("i").Name & ".xls"  '(工作表名称为文件名）
       ActiveWorkbook.Close
回复

使用道具 举报

hamsik11
发表于 2012-10-22 17:37 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
qjsu 发表于 2012-10-22 17:13
主要是这句，上面的应该没有错
      Sheets(i).Copy
      

Sheets("i")换成 Sheets(i)
回复

使用道具 举报

qjsu
 楼主| 发表于 2012-10-22 17:53 | 显示全部楼层
hamsik11 发表于 2012-10-22 17:37
Sheets("i")换成 Sheets(i)

提示下标越界啊~亲~~~
回复

使用道具 举报

hamsik11
发表于 2012-10-22 18:03 | 显示全部楼层
qjsu 发表于 2012-10-22 17:53
提示下标越界啊~亲~~~

我不知道你要干啥............ActiveWorkbook用的有问题...
回复

使用道具 举报

hwc2ycy
发表于 2012-10-22 18:09 | 显示全部楼层    本楼为最佳答案   
本帖最后由 hwc2ycy 于 2012-10-22 18:11 编辑
  1. Sub 去除公式连接()
  2.     Dim i As Integer
  3.     Dim sFilename
  4.     Dim y As Integer
  5.     Application.ScreenUpdating = False
  6.     '关闭警告信息和对话框，默认情况下重名文件会被覆盖
  7.     Application.DisplayAlerts = False
  8.     ' 跳过错误
  9.     On Error Resume Next
  10.     '检测输入值是否合法
  11.     y = CInt(InputBox("请输入表格数量"))
  12.     If y > Worksheets.Count Or y = 0 Then
  13.         MsgBox "请输入正确的工作表数量" & "[<" & Worksheets.Count & "]"
  14.         Exit Sub
  15.     End If
  16.     For i = 2 To y + 1
  17.         Sheets(i).Select
  18.         sFilename = ThisWorkbook.Path & Application.PathSeparator & Sheets(i).Name & ".xls"
  19.         'sfilename= ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Sheets(i).Name & ".xls"
  20.         Columns("A:M").Select
  21.         Selection.Copy
  22.         Selection.PasteSpecial Paste:=xlPasteValues
  23.         Application.CutCopyMode = False
  24.         Columns("A:D").Select
  25.         Range("D1").Activate
  26.         Selection.Delete Shift:=xlToLeft
  27.         Columns("J:K").Select
  28.         Selection.Delete Shift:=xlToLeft
  29.         Sheets(i).Copy
  30.         
  31.         'ActiveWorkbook.SaveAs Application.ActiveWorkbook.Path & "" & Sheets("i").Name & ".xls"  '(工作表名称为文件名）
  32.          Debug.Print sFilename
  33.         ActiveWorkbook.SaveAs Filename:=sFilename, FileFormat:=xlExcel7
  34.         'ActiveWorkbook.Close True, Filename:=sFilename
  35.         ActiveWorkbook.Close
  36.     Next
  37.     Application.ScreenUpdating = True
  38.     Application.DisplayAlerts = True
  39. End Sub
复制代码
回复

使用道具 举报

qjsu
 楼主| 发表于 2012-10-22 18:41 | 显示全部楼层
hwc2ycy 发表于 2012-10-22 18:09

有2个问题
第一：保存格式要使用2007的
第二：生成的excel里面没有保存原来合并单元格的部分，导致格式改变了，能改吗？

回复

使用道具 举报

hwc2ycy
发表于 2012-10-22 18:55 | 显示全部楼层
本帖最后由 hwc2ycy 于 2012-10-22 19:25 编辑
qjsu 发表于 2012-10-22 18:41
有2个问题
第一：保存格式要使用2007的
第二：生成的excel里面没有保存原来合并单元格的部分，导致格式 ...


粘贴的时候只粘贴数值就会保留格式了，刚刚说弄了，那个是数字格式。
回复

使用道具 举报

qjsu
 楼主| 发表于 2012-10-22 18:58 | 显示全部楼层
hwc2ycy 发表于 2012-10-22 18:55
格式改下就成。但是如果格式也一块复制过来，那就把粘贴换一种参数就行，格式 和数值。

我把涉及到的.xls都改成".xlsx后文件打不开鸟
回复

使用道具 举报

qjsu
 楼主| 发表于 2012-10-22 19:08 | 显示全部楼层
就是还有点小问题，我把涉及到的.xls都改成".xlsx后生成出来的excel打不开了
回复

使用道具 举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-25 09:41 , Processed in 0.365629 second(s), 8 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表