标题:请教一个问题,找遍了baidu,但是没有答案
只看楼主
start1901
Rank: 1
等 级:新手上路
帖 子:25
专家分:4
注 册:2018-2-26
结帖率:40%
已结贴  问题点数:20 回复次数:10 
请教一个问题,找遍了baidu,但是没有答案
我写了一个VB程序,批量处理excel文件,由于有很多重复语句,需要劈分成几个sub子程序,如下代码中标注之间这段,试了几遍都不行,
问题1:不知道这种with怎么传递到子过程中,
问题2:在子函数中需要把Set xlapp = CreateObject("Excel.Application")再写一遍么,子函数中“d1 = .Cells(k, 46) + d1”总是提示错误,
求大神帮忙指点一下,谢谢!


Private Sub Command15_Click()  
pb1 = "D:\55.xls"
Set xlapp = CreateObject("Excel.Application")
xlapp.Visible = True
Set xlBook = xlapp.Workbooks.Open(pb1)   
Set xlSheet = xlBook.Worksheets(1)
With xlSheet

  a1 = ylSheet.Cells(2, 4)
      For k = 5 To m  ',
         If InStr(.Cells(k, 7), "算前") <> 0 And InStr(.Cells(k, 8), "已开") <> 0 And IsNumeric(.Cells(k, 46)) And .Cells(k, 46) > 0 Then  
           '以下这段想写进sub子程序
           d1 = .Cells(k, 46) + d1
           por = .Cells(k, 47) + por
           So = .Cells(k, 48) + So
           WF = .Cells(k, 16) + WF
           WD = .Cells(k, 17) + WD
           YF = .Cells(k, 18) + YF
           RRWF = .Cells(k, 21) + RRWF
           RRWD = .Cells(k, 22) + RRWD
           RRYF = .Cells(k, 23) + RRYF
           JJWF = .Cells(k, 24) + JJWF
           JJWD = .Cells(k, 25) + JJWD
           JJYF = .Cells(k, 26) + JJYF
           LCWF = .Cells(k, 30) + LCWF
           LCWD = .Cells(k, 31) + LCWD
           LCYF = .Cells(k, 32) + LCYF
            .Cells(m1, 9) = a1
            If a1 <> 0 Then .Cells(m1, 10) = d1 / a1
            If d1 <> 0 Then .Cells(m1, 11) = por / d1
            If por <> 0 Then .Cells(m1, 12) = So / por
            If So <> 0 And YF <> 0 Then .Cells(m1, 13) = 1 / (WF * 100 / So)
            If WF <> 0 Then .Cells(m1, 14) = WD / WF
            If WF <> 0 Then .Cells(m1, 15) = YF * 10000 / WF
            a1 = 0
            d1 = 0
            por = 0
            '以上这段想写进sub子程序
         End If ',5
      Next ',4
 下面代码无关省略
搜索更多相关主题的帖子: Sub Set And If Then 
2018-12-10 00:41
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4912
专家分:29900
注 册:2008-10-15
得分:5 
1、一般情况下,在子程序中不需要再重写 Set xlapp = CreateObject("Excel.Application")
2、子函数中“d1 = .Cells(k, 46) + d1”总是提示错误。因为你这个需要使用一个对象,这个对象需要传递进去。

sub AA(obj as Worksheets  )      '名字参考你 xlSheet 的定义用的类型,浏览器直接写的, 忘了。
with obj
    .....
end with
end sub

授人于鱼,不如授人于渔
早已停用QQ了
2018-12-10 09:11
wds1
Rank: 11Rank: 11Rank: 11Rank: 11
等 级:贵宾
威 望:49
帖 子:393
专家分:2025
注 册:2016-3-10
得分:0 
你那个报错或者说列的数据不存在,或者是单元格内容与变量类型d1不一致,需要看具体报错原因。

我一般处理execl都是一次性读入内存数组,之后操作内存数据。

这么处理对于数据量大的表速度比较快,而且后续处理的语句也相对简单。

1、调用格式
Call Load_Execl("execl文件名","sheet名", "内存数组变量mem1")

2、下表是读取execl的子程序,最好放到类模块     
'============================================================
'  读取EXECL到内存数组【速度快-优选】
'  输入参数:execl名字、sheet名【需要DAO控件】
'  输出参数:txt1内存数组
'============================================================
Public Sub Load_Execl(ByVal execl_name As String, ByVal sheet_name, txt1)
  Dim cn As New ADODB.Connection
  Dim rs As New ADODB.Recordset
  Dim i As Long, j As Long
  If Right(execl_name, Len(execl_name) - InStrRev(execl_name, ".")) = "xls" Then
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;data source=" & execl_name & ";extended properties= 'Excel 8.0;HDR=YES;IMEX=1';"
  ElseIf Right(execl_name, Len(execl_name) - InStrRev(execl_name, ".")) = "xlsx" Then
    cn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Persist Security Info=False;data source=" & execl_name & ";extended properties= 'Excel 12.0;HDR=YES;IMEX=1';"
  End If
  rs.Open "select * from [" + sheet_name + "$]", cn, adOpenKeyset, adLockOptimistic
  ReDim txt1(rs.RecordCount, rs.Fields.Count)
  For i = 1 To rs.Fields.Count: txt1(0, i) = rs.Fields(i - 1).Name: Next i '读第一行【首行当标题了】
  For i = 1 To rs.RecordCount '读其余行
    For j = 1 To rs.Fields.Count: txt1(i, j) = IIf(Not IsNull(rs.Fields(j - 1)), rs.Fields(j - 1), ""): Next j
    rs.MoveNext
  Next i
  Set rs = Nothing
  Set cn = Nothing
End Sub
2018-12-10 09:24
start1901
Rank: 1
等 级:新手上路
帖 子:25
专家分:4
注 册:2018-2-26
得分:0 
回复 3楼 wds1
谢谢啊,这也是个办法,但我还是想知道,当必须在excel内计算,怎么写子程序,正如我例子中那段代码怎么写到子程序中
2018-12-10 18:58
start1901
Rank: 1
等 级:新手上路
帖 子:25
专家分:4
注 册:2018-2-26
得分:0 
回复 2楼 风吹过b
我的定义是
Dim xlapp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
我的子过程按你说的写了:
sub xxx(abc as Excel.Worksheet )
  with xlsheet
  ...
  end with
end sub
但是调用的时候提示"对象不支持该属性或方法",调用语句如下:
xxx(xlsheet)

帮忙看看错误处在哪里,谢谢啊
2018-12-10 19:22
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4912
专家分:29900
注 册:2008-10-15
得分:0 
sub xxx(abc as Excel.Worksheet )
  with abc    '这里是形参的名字。
  ...
  end with
end sub

在手机上没法写代码,最近很忙。

授人于鱼,不如授人于渔
早已停用QQ了
2018-12-10 21:00
wds1
Rank: 11Rank: 11Rank: 11Rank: 11
等 级:贵宾
威 望:49
帖 子:393
专家分:2025
注 册:2016-3-10
得分:0 
给你个execl程序调用的例子【需要引用execl object 库】
Public t1
Private Sub Command1_Click()
 pb1 = "D:\55.xls"
 Dim xlapp As Excel.Application
 Dim xlBook As Excel.Workbook
 Dim xlSheet As Excel.Worksheet
 Set xlapp = CreateObject("Excel.Application")
 Set xlBook = xlapp.Workbooks.Open(pb1)
 Set xlSheet = xlBook.Worksheets(1)
 Call sub1(xlSheet, 1, 1)
 Debug.Print t1'打印第一行第一列数据
 Call sub1(xlSheet, 1, 2)
 Debug.Print t1'打印第一行第二列数据
 xlBook.Close
 xlapp.Quit
End Sub

Private Sub sub1(a1 As Excel.Worksheet, col1, row1)
  t1 = a1.Cells(col1, row1)
End Sub
2018-12-10 21:24
start1901
Rank: 1
等 级:新手上路
帖 子:25
专家分:4
注 册:2018-2-26
得分:0 
回复 6楼 风吹过b
不好意思,给您回复的时候写错了,代码里我写的是形参的名字,更正一下:
 
Dim xlSheet As Excel.Worksheet
子过程:
sub xxx(abc as Excel.Worksheet )
  with abc  
  ...
  end with
end sub
调用语句如下:
xxx(xlsheet)

调用的时候提示"对象不支持该属性或方法",能否帮忙再看一下,谢谢了
2018-12-10 21:39
start1901
Rank: 1
等 级:新手上路
帖 子:25
专家分:4
注 册:2018-2-26
得分:0 
回复 7楼 wds1
谢谢啊,例子很有用,我在子程序里加了一个形参就能运行了,现在是sub xxx(abc as Excel.Worksheet , m1),原来这里不能只有一个abc as Excel.Worksheet
想问下你的例子是哪里找的啊,我还是学习阶段,想每次有问题了能有个实例参照,有专门的VB6操作excel的书么,还是其他什么?
2018-12-10 22:38
wds1
Rank: 11Rank: 11Rank: 11Rank: 11
等 级:贵宾
威 望:49
帖 子:393
专家分:2025
注 册:2016-3-10
得分:15 
实例是自己写的,运行没问题才贴的。

书上讲的一般都不是很清晰。

最直接的方法是打开execl,开启录制宏,你对execl操作,系统自动记录vba脚本,其中95%以上代码都可以挪到VB直接运行,这样学习vb操作execl最快。

另外带不带参数没影响,还是你自己的语句问题,下面就是不带参数的
【带参数是可以方便控制读取指定行列,否则只能用公共变量控制读取范围】

Private Sub Command1_Click()
 pb1 = "D:\55.xls"
 Dim xlapp As Excel.Application
 Dim xlBook As Excel.Workbook
 Dim xlSheet As Excel.Worksheet
 Set xlapp = CreateObject("Excel.Application")
 Set xlBook = xlapp.Workbooks.Open(pb1)
 Set xlSheet = xlBook.Worksheets(1)
 Call sub1(xlSheet)
 Debug.Print t1 '打印第一行第一列数据
 xlBook.Close
 xlapp.Quit
End Sub

Private Sub sub1(a1 As Excel.Worksheet)
  '这里是取第一行第一列
  '你原程序应该是此处取M行数据,因此M必须为public变量或者为参数,否则为空,就会出错
  t1 = a1.Cells(1, 1)
End Sub


[此贴子已经被作者于2018-12-11 09:02编辑过]

2018-12-11 08:44



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-491932-1-1.html




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

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