用ADO不打开源文件，读取其资料，已成功，请教其中两个小问题

lanny.mo

代码是从Home下的，可以正常运行，问代码中的两个小问题

RST.Open "select * from [Sheet1$A1:H12]", CNN, 1, 3

其中的[Sheet1$A1:H12] 工作表怎么用变量表示，有网友给的建议[" & Sheets(i).Name & "$A1:H12]，但不能完全正常运行

睡了，希望明天起来有个好结果


[Sheet1$A1:H12]其中工作表用变量是怎么写的，
行号及列号的变量向下面这样写是可以，有没有更简单的
[Sheet1$" & Chr(97 + j) & (i + 1) & ":" & Chr(97 + j) & (i + 1) & "]

还有这个地址变量又是怎么写的呢
"data source=D:\Book1.xls"

如果我是要复制到本工作簿，地址又是怎么写的


代码如下


Sub bb()
Dim CNN As New ADODB.Connection
Dim RST As New ADODB.Recordset
Dim arr() As Variant
Dim iRow As Integer
Dim iCol As Integer
With CNN
.ConnectionString = "provider=microsoft.jet.oledb.4.0;" & _
"extended properties='Excel 8.0;hdr=no';" & _
"data source=D:\Book1.xls"
.Open
End With
RST.Open "select * from [Sheet1$A1:H12]", CNN, 1, 3
iRow = RST.RecordCount
iCol = RST.Fields.Count
ReDim arr(1 To iRow, 1 To iCol) As Variant
For i = 1 To iRow
    For j = 1 To iCol
        arr(i, j) = RST.Fields(j - 1).Value
    Next j
    RST.MoveNext
Next i
'RST.Update
RST.Close
CNN.Close
With CNN
.ConnectionString = "provider=microsoft.jet.oledb.4.0;" & _
"extended properties='Excel 8.0;hdr=no';" & _
"data source=D:\Book2.xls"
.Open
For i = 1 To iRow
    For j = 1 To iCol
    strt = "update [Sheet1$" & Chr(97 + j) & (i + 1) & ":" & Chr(97 + j) & (i + 1) & "] set f1='" & arr(i, j) & "'"
    .Execute strt
    Next j
Next i
End With
CNN.Close
End Sub

[ 本帖最后由 lanny.mo 于 2011-1-7 00:49 编辑 ]

lanny.mo

问题一，群热心网友已经帮解决
Dim kk As String
kk = "D:\test1.xls"
"data source＝" & kk

zhaogang1960

Dim cnn As New ADODB.Connection
Dim RST As New ADODB.Recordset
Dim arr() As Variant
Dim iRow As Integer
Dim iCol As Integer
With cnn
.ConnectionString = "provider=microsoft.jet.oledb.4.0;" & _
"extended properties='Excel 8.0;hdr=no';" & _
"data source=" & ThisWorkbook.Path & "\Test1.xls"
.Open
End With
RST.Open "select * from [1$A1:H65536] where f1 is not null", cnn, 1, 3 '有改动
iRow = RST.RecordCount
iCol = RST.Fields.Count

ReDim arr(1 To iRow, 1 To iCol) As Variant

For i = 1 To iRow
    For j = 1 To iCol
        arr(i, j) = RST.Fields(j - 1).Value
    Next j
    RST.MoveNext
Next i
'RST.Update
RST.Close
cnn.Close

With cnn
.ConnectionString = "provider=microsoft.jet.oledb.4.0;" & _
"extended properties='Excel 8.0;hdr=no';" & _
"data source=" & ThisWorkbook.Path & "\Test2.xls"
.Open
For j = 1 To iCol
   
Next
For i = 1 To iRow
    s = ""
    For j = 1 To iCol
        If arr(i, j) <> "" Then s = s & "f" & j & "='" & arr(i, j) & "' ," Else s = s & "f" & j & "=null,"
    Next j
     strt = "update [Sheet1$" & Cells(i + 1, 2).Resize(, 8).Address(0, 0) & "] set " & Left(s, Len(s) - 1)
    .Execute strt '一次更新一行
Next i
End With

cnn.Close
Set cnn = Nothing
Set RST = Nothing
End Sub

zhaogang1960

fdsfefd.rar (19.91 KB, 下载次数: 42)

2011-1-7 00:01 上传

点击文件名下载附件

lanny.mo

谢谢楼上大侠帮助，可能是我描写的不清楚，让您误会了，运行后，不是想要的效果

想要的效果是test1中的工作表1到工作表5中的B5:I5复制到test2中的工作表“1”

其它网友的帮忙，三个问题，有两个可以正常，有一个不知错在那，有时可以正常，有时不行，帮忙看一下，谢谢

问题一正常 地址变量
"data source=D:\Book1.xls"
"data source=" & I

问题二正常 本工作表
"data source=D:\Book1.xls"
"data source=" & ThisWorkbook.fullname

问题三，不行  工作表变量

[Sheet1$A1:H12]

[" & Sheets(i).Name & "$A1:H12]

lanny.mo

问题三，不行  工作表变量

[Sheet1$A1:H12]

[" & Sheets(i).Name & "$A1:H12]


运行显示下标出界

lanny.mo

RST.Open "select * from [Sheet1$A1:H12]", CNN, 1, 3


其中的[Sheet1$A1:H12] 工作表怎么用变量表示，有网友给的建议[" & Sheets(i).Name & "$A1:H12]，但不能完全正常运行

睡了，希望明天起来有个好结果

zhaogang1960

[" & Sheets(i).Name & "$A1:H12]方法是不可取的，因为工作簿没有打开，无法取得Sheets(i).Name
可以利用ADOX取得工作表名，但是取得工作表名的顺序是按文本排序的：1$、10$、2$、3$、3232$、4$……，你只需要汇总1—5个表，用这种方式也不合适
下面采用已知1—5个表名的办法：
Sub bb()
Dim cnn As New ADODB.Connection
Dim RST As New ADODB.Recordset
Dim arr() As Variant
Dim iRow As Integer
Dim iCol As Integer
With cnn
.ConnectionString = "provider=microsoft.jet.oledb.4.0;" & _
"extended properties='Excel 8.0;hdr=no';" & _
"data source=" & ThisWorkbook.Path & "\Test1.xls"
.Open
End With
For i = 1 To 5
    If Len(strt) Then strt = strt & " union all "
    strt = strt & "select * from [" & i & "$A1:H12]"
Next
RST.Open strt, cnn, 1, 3
iRow = RST.RecordCount
iCol = RST.Fields.Count

ReDim arr(1 To iRow, 1 To iCol) As Variant

For i = 1 To iRow
    For j = 1 To iCol
        arr(i, j) = RST.Fields(j - 1).Value
    Next j
    RST.MoveNext
Next i
'RST.Update
RST.Close
cnn.Close

With cnn
.ConnectionString = "provider=microsoft.jet.oledb.4.0;" & _
"extended properties='Excel 8.0;hdr=no';" & _
"data source=" & ThisWorkbook.Path & "\Test2.xls"
.Open
For j = 1 To iCol
   
Next
For i = 1 To iRow
    s = ""
    For j = 1 To iCol
        If arr(i, j) <> "" Then s = s & "f" & j & "='" & arr(i, j) & "' ," Else s = s & "f" & j & "=null,"
    Next j
     strt = "update [Sheet1$" & Cells(i + 1, 2).Resize(, 8).Address(0, 0) & "] set " & Left(s, Len(s) - 1)
    .Execute strt '一次更新一行
Next i
End With

cnn.Close
Set cnn = Nothing
Set RST = Nothing
End Sub

lanny.mo

zhaogang1960大侠您好，好像运行出错，今天上班我搞了一个，工作表的变量试出来了，现在的问题是行和例的变量的问题，还有，当读取的内容范围放大时也会出错，请帮忙看一下，答应老板这个星期要搞好的，呵呵，没想到那么多小问题，如附件所示，先谢谢了

zhaogang1960

附件没有看懂
行和列变量问题就是个区域相对地址问题，可以用
cells(i,j).resize(r,c).address(0,0)表示
cells部分是起点
r是向下延伸，c是向右延伸