求高手指点.

ydd623922941

动态提取多个excel表格数据
Sub addexceldata()
Dim s, i As Byte, cnn As Object, rs As Object, SQL$, Arr, Brr(1 To 9999, 1 To 12), j As Integer, m As Integer
s = Application.GetOpenFilename("Excel2007 Files (*.xlsx), *.xlsx", MultiSelect:=True)
If Not IsArray(s) Then Exit Sub
For i = 1 To UBound(s)
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & s(i)
        SQL = "select FAMILY_NAME,WEEK,gld_disks,gld_ds,ds_yld,p12_yld ,pw_yld,RT_yld,p1_yld,mag_disks,mag_ds,mag_yld from [yield$a1:u100] " '这个yield名字是不一样的.
        Set rs = cnn.Execute(SQL)
        Arr = rs.getRows
            For j = 0 To UBound(Arr, 2)
                m = m + 1
                Brr(m, 1) = Arr(0, j)
                Brr(m, 2) = Arr(1, j)
                Brr(m, 3) = Arr(2, j)
                Brr(m, 4) = Arr(3, j)
                Brr(m, 5) = Arr(4, j)
                Brr(m, 6) = Arr(5, j)
                Brr(m, 7) = Arr(6, j)
                Brr(m, 8) = Arr(7, j)
                Brr(m, 9) = Arr(8, j)
                Brr(m, 10) = Arr(9, j)
                Brr(m, 11) = Arr(10, j)
                Brr(m, 12) = Arr(11, j)
            Next
Next
Application.ScreenUpdating = False
Range("A60000").End(xlUp).Offset(1).Resize(m, 12) = Brr
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
'[a:f].RemoveDuplicates Header:=xlYes, Columns:=Array(1, 2, 3, 4, 5, 6)
'Range("a2:h999").Interior.ColorIndex = 28
[a2:f999].Borders.LineStyle = xlContinuous
Application.ScreenUpdating = True
End Sub

ydd623922941

我要取的 工作簿的工作表的表名是不相等   [Sheet1$]也不行

ydd623922941

不能沉啊 有兴趣的 可以挑战一下 附件有数据

microyip

ydd623922941 发表于 2019-6-14 16:54
不能沉啊 有兴趣的 可以挑战一下 附件有数据

谁闲没事去“挑战”一下？你求助就认真求助，别搞这种字眼