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

阿智

非常感谢你在百忙之中抽空为我解答。问题如下：用ExecuteExcel4Macro提取一个未打开的excel文件并从sheet1中将已经选好的数据范围提取到一个新的EXCEL文件中指定的位置。

请看附件。

蓝桥玄霜

1，“不能打开 数据文件.xlsx”，怎么先选中其中的区域？
2，为什么还要用ExecuteExcel4Macro？这个方法太老旧了，Excel 4.0的东西，属于淘汰之列了。

阿智

蓝桥玄霜 发表于 2022-2-13 09:38
1，“不能打开 数据文件.xlsx”，怎么先选中其中的区域？
2，为什么还要用ExecuteExcel4Macro？这个方法太 ...

谢谢回复，由于实际的数据文件比较大，打开需要很长时间。
不打开文件的情况下提取里面已选定的数据，希望得到你的帮助。

蓝桥玄霜

不打开文件的情况下怎么知道里面已选定什么数据？除非已经知道要提取某些单元格的数据。
如果是这样，可以用With GetObject(myPath & myName)

阿智

蓝桥玄霜 发表于 2022-2-13 17:08
不打开文件的情况下怎么知道里面已选定什么数据？除非已经知道要提取某些单元格的数据。
如果是这样，可以 ...

谢谢回复，已知每次需要提取的数据都是在最后的。

阿智

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

perfect131

打开获取关闭不行嘛？
很好奇多大的文件？

阿智

perfect131 发表于 2022-2-15 09:33
打开获取关闭不行嘛？
很好奇多大的文件？

谢谢你的回复。文件打开要十来分钟。好像只有ExecuteExcel4Macro可以做到不打开提取里面的数据，但是我想提取里面已选定范围的数据，试了好久都不行，望得到帮助。

perfect131

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

可以用公式获取，这个比较快
参考：https://club.excelhome.net/thread-378456-1-1.html

perfect131

改进版本，50000行96列，38秒已经很不错了

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.     i = 50000
   
10.     RangeName = "a1:CS" & i
    
11.     bbb Path, WorkbookName, SheetName, RangeName
    
12.     Sheet1.Range(RangeName).Clear
    
13.     arr = Sheet2.Range(RangeName).Value
    
14.     '''Sheet2.Cells.Clear  'Sheet2为临时工作表
    
15.     Sheet1.Range(Split(RangeName, ":")(0)).Resize(UBound(arr), UBound(arr, 2)) = arr '测试效果
    
16.     Debug.Print Timer - t
    
17. End Sub
    
18. Sub bbb(Path, WorkbookName, SheetName, RangeName)
    
19.     With Sheet2
    
20.         With .Range(RangeName)
    
21.             f = "'" & Path & "\[" & WorkbookName & "]" & SheetName & "'!" & Split(RangeName, ":")(0)
    
22.             .Formula = "=IF(ISBLANK(" & f & ")," & """""" & "," & f & ")"
    
23.             .Value = .Value
    
24.           '''0值 替换为 空
    
25. '''          .Replace 0, "", xlWhole
    
26.         End With
    
27.     End With
    
28. End Sub
    

复制代码