| 网站首页 | 业界新闻 | 小组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
买学问 - 大牛一对一辅导,有问必答买学问 - 专业的付费知识问答平台
共有 451 人关注过本帖
标题:请帮忙分析一下代码
只看楼主 加入收藏
事业男儿
Rank: 2
等 级:论坛游民
帖 子:279
专家分:14
注 册:2007-4-25
结帖率:80%
  已结贴   问题点数:20  回复次数:3   
请帮忙分析一下代码
问题:在日常工作中需要对庞大的EXCEL部分数据进行删除,例如下面在网上找的代码,在第9行的  ("2:7619")  说的是删除表格第2行----7619行,但是程序一旦生产应用程序就不能更改了。请问各位老师 能不能在窗体上放一个控件 text1 ,以后直接在空间里输入  "x:x".
[code]'菜单“工程/引用”,勾选Microsoft Excel 11库,必须的
Private Sub Command1_Click()

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then Set xlApp = CreateObject("Excel.Application")
On Error GoTo prcERR
Set xlBook = xlApp.Workbooks.Open(App.Path & "\test.xls") '打开你的EXCEL文件
Set xlSheet = xlBook.Worksheets(1) '第一个表格
xlSheet.Application.Visible = True '设置Excel 可见
 xlSheet.Rows("2:7619").Delete Shift:=xlUp '假如要删除第1行。删除第2行就是"2:2",删除1-3行就是"1:3"
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Exit Sub
prcERR:
 Debug.Print Err.Number & ":" & Err.Description
End Sub

[此贴子已经被作者于2018-12-19 23:54编辑过]

2018-12-19 23:52
icecool
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:20
帖 子:1205
专家分:1309
注 册:2005-3-14
  得分:7 
xlSheet.Rows("2:7619").Delete Shift:=xlUp


--->   xlSheet.Rows(text1.text).Delete Shift:=xlUp

loading...
2018-12-20 09:11
a6681316
Rank: 1
等 级:新手上路
帖 子:20
专家分:7
注 册:2010-12-17
  得分:7 
添加2个text

比如是text1 和text2





Private Sub Command1_Click()
if text1.text="" or text2.text="" then
msgbox "请输入开始行和结束行"

else
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
DIM X,Y

X=text1.text
Y=text2.text
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then Set xlApp = CreateObject("Excel.Application")
On Error GoTo prcERR
Set xlBook = xlApp.Workbooks.Open(App.Path & "\test.xls") '打开你的EXCEL文件
Set xlSheet = xlBook.Worksheets(1) '第一个表格
xlSheet.Application.Visible = True '设置Excel 可见
 xlSheet.Rows(X:Y).Delete Shift:=xlUp '假如要删除第1行。删除第2行就是"2:2",删除1-3行就是"1:3"
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Exit Sub
prcERR:
 Debug.Print Err.Number & ":" & Err.Description

end if

End Sub



*这边其实还要定义 Text框只能输入数字,要不然也会出现bug
2018-12-20 10:04
ZHRXJR
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:95
帖 子:878
专家分:4602
注 册:2016-5-10
  得分:7 
Private Sub Command2_Click()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim a As Integer, b As Integer   '设置变量
a = Val(Text1.Text): b = Val(Text2.Text)   '给变量赋值
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then Set xlApp = CreateObject("Excel.Application")
On Error GoTo prcERR
Set xlBook = xlApp.Workbooks.Open(App.Path & "\test.xls") '打开你的EXCEL文件
Set xlSheet = xlBook.Worksheets(1) '第一个表格
xlSheet.Application.Visible = True '设置Excel 可见
 xlSheet.Rows(a & ":" & b).Delete Shift:=xlUp   '注意,必须是 a & ":" & b 的格式。不能写成 a: b ,这样就会出错。

 xlSheet.Rows(Val(Text1.Text) & ":" & Val(Text1.Text)).Delete Shift:=xlUp
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Exit Sub
prcERR:
 MsgBox Err.Number & ":" & Err.Description
End Sub
没有调试,应该是这样吧。
2018-12-20 13:39







关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.027608 second(s), 9 queries.
Copyright©2004-2019, BCCN.NET, All Rights Reserved