如何用ExecuteExcel4Macro方法提取工作簿中已选中的数据

zpy2

阿智 发表于 2022-2-16 01:07
谢谢你的回复。文件打开要十来分钟。好像只有ExecuteExcel4Macro可以做到不打开提取里面的数据，但是我想 ...

GetObject(myPath & myName)试过了，会打开文件

ExecuteExcel4Macro会不打开文件？

只是感觉吧，速度要快，还是直接登记一张表最快。

perfect131

ExecuteExcel4Macro感觉没那么快、1000行96列将近用了400秒
.Formula就比较快

阿智

perfect131 发表于 2022-2-17 12:27
改进版本，50000行96列，38秒已经很不错了

谢谢回复，问题的关键在于只知道每次更新后的数据中所要选取的是在第2行到第21行，最后1列到倒数第9列这个范围的数据。

perfect131

阿智 发表于 2022-2-17 15:08
谢谢回复，问题的关键在于只知道每次更新后的数据中所要选取的是在第2行到第21行，最后1列到倒数第9列这 ...

这也不是不可以

1. Sub aaa() '假设从本目录"数据文件.xlsx"工作簿"Sheet1"的"A:CS"列取值
   
2.     t = Timer
   
3.     Dim i As Long
   
4.     Dim arr As Variant
   
5.     Sheet2.Cells.Clear 'Sheet2为临时工作表
   
6.     Path = ThisWorkbook.Path
   
7.     WorkbookName = "数据文件.xlsx"
   
8.     SheetName = "Sheet1"
   
9.     For i = 2 To 21
   
10.         f = "'" & Path & "\[" & WorkbookName & "]" & SheetName & "'!" & i & ":" & i
    
11.         Sheet2.Cells(i - 1, 1) = "=MATCH(9.99999E+307," & f & ")"
    
12.     Next
    
13.     lie = WorksheetFunction.Max(Sheet2.Range("a1:a20").Value)
    
14.     lie1 = Split(Cells(1, lie - 8).Address, "$")(1)
    
15.     lie2 = Split(Cells(1, lie).Address, "$")(1)
    
16.     Sheet2.Cells.Clear 'Sheet2为临时工作表
    
17.     RangeName = lie1 & "2:" & lie2 & "21"
    
18.     bbb Path, WorkbookName, SheetName, RangeName
    
19.     Sheet1.Range(RangeName).Clear
    
20.     arr = Sheet2.Range(RangeName).Value
    
21.     '''Sheet2.Cells.Clear  'Sheet2为临时工作表
    
22.     Sheet1.Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr '测试效果
    
23. ''    Sheet1.Range(Split(RangeName, ":")(0)).Resize(UBound(arr), UBound(arr, 2)) = arr '测试效果
    
24.     Debug.Print Timer - t
    
25. End Sub
    
26. Sub bbb(Path, WorkbookName, SheetName, RangeName)
    
27.     With Sheet2
    
28.         With .Range(RangeName)
    
29.             f = "'" & Path & "\[" & WorkbookName & "]" & SheetName & "'!" & Split(RangeName, ":")(0)
    
30.             .Formula = "=IF(ISBLANK(" & f & ")," & """""" & "," & f & ")"
    
31.             .Value = .Value
    
32.           '''0值 替换为 空
    
33. '''          .Replace 0, "", xlWhole
    
34.         End With
    
35.     End With
    
36. End Sub

复制代码