|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- '*********************************
- '******* 北极狐工作室出品 ******
- '******* QQ:14885553 ******
- '*********************************
- Sub Opiona()
- 'On Error Resume Next '// 发生错误,自动执行下一句,就是忽略错误
- Application.ScreenUpdating = False '//关闭屏幕刷新
- Application.DisplayAlerts = False '//关闭系统提示
- t = Timer '//开始时间
- Set SH2 = Sheets("资产负债表汇总")
- SH2.Range("C1:AZ65536").ClearContents
- FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, False)
- For i = 0 To UBound(FileArr)
-
- Str_coon = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=NO';Data Source =" & FileArr(i) '//OFFICE2007
- StrSQL = "SELECT B.年初余额 FROM ("
- StrSQL = StrSQL & "SELECT F1 AS 资产 FROM [Excel 12.0;HDR=NO;Database=" & ThisWorkbook.FullName & "].[资产负债表汇总$A3:A100]"
- StrSQL = StrSQL & ") AS A LEFT JOIN ( "
- StrSQL = StrSQL & "SELECT F1 AS 资产,F3 AS 期末余额,F4 AS 年初余额 FROM [资产负债表$A6:D38] WHERE LEN(F1)>0"
- StrSQL = StrSQL & " UNION ALL "
- StrSQL = StrSQL & " SELECT F1 AS 资产,F3 AS 期末余额,F4 AS 年初余额 FROM [资产负债表$E6:H38] WHERE LEN(F1)>0"
- StrSQL = StrSQL & ") AS B ON A.资产=B.资产"
- SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
- SH2.Cells(2, i + 3) = Replace(GetPathFromFileName(FileArr(i)), "财务报表", "") '//想要正确按照月份排序,命名应该为:01月、02月10月
- SH2.Range(SH2.Cells(3, i + 3).Address).Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR
-
- Next i
- Application.ScreenUpdating = True '//恢复屏幕刷新
- Application.DisplayAlerts = True '//恢复系统提示
- MsgBox "一共用时:" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!" '//提示所用时间
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|