VBA打开文件夹下所有excel文件并复制数据

mashimaro0425

zhaogang1960 发表于 2011-12-15 16:22
Long 数据类型
      

谢谢啦.看来我应该多看看帮助。

Eutopian

mashimaro0425 发表于 2011-12-15 17:34
谢谢啦.看来我应该多看看帮助。

我以前曾經在鍵盤數字鍵和F1~F6鍵之間的那點空位寫上標記
Sng   Cur   Dbl   Str   Int   Lng
!       @     #     $     %    &
1      2      3      4     5     7

falseface

强大的代码啊。可是我有个问题。就是如果有07版本的excel在就不好用了 有可能把07自动存成03 然后把07的删除么？

zhaogang1960

falseface 发表于 2012-3-10 21:22
强大的代码啊。可是我有个问题。就是如果有07版本的excel在就不好用了 有可能把07自动存成03 然后把07的删除 ...

改为2007可使用的：
Sub Macro1()
    Dim MyPath$, MyName$, sh As Worksheet, arr
    Set sh = ActiveSheet
    MyPath = ThisWorkbook.Path & "\"
    MyName = Dir(MyPath & "*.xlsx") '改为xlsx
    Application.ScreenUpdating = False
    [a1].CurrentRegion.Offset(2).ClearContents
    Do While MyName <> ""
        If MyName <> ThisWorkbook.Name Then
            With GetObject(MyPath & MyName)
                arr = .Sheets(1).[a1].CurrentRegion.Offset(1)
                sh.Cells(sh.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(arr) - 1, 8) = arr '去掉65536
                .Close False
            End With
        End If
        MyName = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "ok"
End Sub

请注意，另存为2007启用宏的工作簿(.xlsm)

falseface

zhaogang1960 发表于 2012-3-10 22:31
改为2007可使用的：
Sub Macro1()
    Dim MyPath$, MyName$, sh As Worksheet, arr

活雷锋啊！！！
我可以贪心的问下，既有07 又有03 肿么办么？
还有一个其他的问题，就是我一个excel里有check box，可以用公式实习 我选择不同的check box 返回不同的值么？谢谢好人！
先粉你微博下。。。。

zhaogang1960

falseface 发表于 2012-3-10 23:09
活雷锋啊！！！
我可以贪心的问下，既有07 又有03 肿么办么？
还有一个其他的问题，就是我一个excel里有 ...

1. Sub Macro1()
   
2.     Dim MyPath$, MyName$, sh As Worksheet, arr
   
3.     Set sh = ActiveSheet
   
4.     MyPath = ThisWorkbook.Path & ""
   
5.     MyName = Dir(MyPath & "*.xls*") '改为xls*
   
6.     Application.ScreenUpdating = False
   
7.     [a1].CurrentRegion.Offset(2).ClearContents
   
8.     Do While MyName <> ""
   
9.         If MyName <> ThisWorkbook.Name Then
   
10.             With GetObject(MyPath & MyName)
    
11.                 arr = .Sheets(1).[a1].CurrentRegion.Offset(1)
    
12.                 sh.Cells(sh.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(arr) - 1, 8) = arr '去掉65536
    
13.                 .Close False
    
14.             End With
    
15.         End If
    
16.         MyName = Dir
    
17.     Loop
    
18.     Application.ScreenUpdating = True
    
19.     MsgBox "ok"
    
20. End Sub
    

复制代码

米兹

我想问一下[a1].CurrentRegion.Offset(2).ClearContents 是什么意思，菜鸟不好意思

gddn

zhaogang1960 发表于 2012-3-10 23:17

好像应该注意一下，当行数超过104万时EXCEL会出错，这个程序会有类似的问题吗？

zhaogang1960

米兹 发表于 2012-6-21 14:30
我想问一下[a1].CurrentRegion.Offset(2).ClearContents 是什么意思，菜鸟不好意思

包含A1单元格的矩形连续区域（[a1].CurrentRegion）下移2行（.Offset(2)）清除数据

zhaogang1960

gddn 发表于 2012-6-21 15:21
好像应该注意一下，当行数超过104万时EXCEL会出错，这个程序会有类似的问题吗？

当数据充满1048576行时，程序会出错，不能使用Offset，因为已经没有任何余地了