如下代码中工作薄地址和工作表都是不一样的 怎么实现用单元格aa1 ab1 ac1 去确定用那一张表的数据
比如 C:\Users\Pictures\2233\工作薄1.xlsx!2344
C:\Users\Pictures\22566\工作薄333.xlsx!2556
C:\Users\Pictures\22\工作薄4444.xlsx!23766
C:\Users\Pictures\25562\工作薄46432.xlsx!23
........
万分感谢了!!!!!!!!!
Sub Cxll()
Dim arr, i&, j&, m&, crr, Brr(), drr, x&, n&, str
Dim d As Object, d1 As Object
Dim wb As Workbook
str = "C:\Users\Pictures\2233\工作薄1.xlsx"
Set wb = GetObject(str)
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
Range("A4:ss" & Rows.Count).ClearContents
crr = Range("A2").CurrentRegion
arr = wb.Sheets("000").Range("A1").CurrentRegion
For i = 1 To UBound(crr, 2)
If crr(2, i) <> "" Then d(crr(1, i)) = crr(2, i)
d1(crr(3, i)) = i
Next
For i = 2 To UBound(arr)
For j = 1 To UBound(arr, 2)
If d.exists(arr(1, j)) Then
If InStr(arr(i, j), d(arr(1, j))) Then n = n + 1
End If
Next
If n = d.Count Then
m = m + 1
ReDim Preserve Brr(1 To m): Brr(m) = i
End If
n = 0
Next
If m = 0 Then ReDim Brr(0)
ReDim drr(0 To m, 1 To d1.Count)
For i = 1 To UBound(Brr)
For j = 1 To UBound(arr, 2)
If d1.exists(arr(1, j)) Then
x = x + 1
drr(i - 1, x) = arr(Brr(i), j)
End If
Next
x = 0
Next
Range("a4").Resize(UBound(drr) + 1, UBound(drr, 2)) = drr
wb.Close False
End Sub
|