阅： 3071 | 回： 1
等级:学者-
积分:76 -
财富值:2 -
身份:普通用户
-
Sub shengge()
-
Dim path$, d$, ws As Workbook
-
Dim arr, brr, i&, j&, k&, s
-
Application.ScreenUpdating = False
-
path = ThisWorkbook.path & "\"
-
d = Dir(path & "*.xls")
-
ReDim brr(1 To Cells.Rows.Count, 1 To 7)
-
Do While d <> ""
-
If d <> ThisWorkbook.Name Then
-
Set ws = Workbooks.Open(path & d)
-
arr = Sheets(1).[a3].CurrentRegion
-
For i = 1 To UBound(arr)
-
If Val(arr(i, 1)) > 0 And Val(arr(i, 5)) > 10000 Then
-
k = k + 1
-
For j = 1 To 7
-
brr(k, j) = arr(i, j)
-
Next
-
End If
-
Next
-
ws.Close False
-
End If
-
d = Dir
-
Loop
-
If k = 0 Then MsgBox "查无符合条件的结果。", 64, "通知": Exit Sub
-
Cells.Clear
-
[a1:g1] = Array("日期", "摘要", "凭证号", "对方科目", "借方", "贷方", "余额")
-
[a2].Resize(k, 7) = brr
- End Sub
我的个性签名