Dim Ar(), AY(), AX(), D As Object
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
fd = .SelectedItems(1)
If .ButtonName = "確定" Then
FS = Dir(fd & "\*.xls")
Do Until FS = ""
fds = fd & "\" & FS
With Workbooks.Open(fds)
C = FS
ReDim Preserve AX(s)
AX(s) = C
End With
FS = Dir
C = Mid(A, 1, 1)
Loop
End If
End With
With Sheets(C)改成Sheets("9")可執行但資料夾內工作表檔名可以是9或他不定，如何讓c與工作表同
For Each A In .Range(.[A2], .[A65536].End(xlUp))
If IsDate(A) Then
Ar = Array(A.Offset(, 0).Value, A.Offset(, 2).Value, A.Offset(, 4).Value, A.Offset(, 5).Value, A.Offset(, 6).Value)
ReDim Preserve AY(s)
AY(s) = Ar
s = s + 1
End If
Next
End With
Workbooks("收支100.xls").Sheets("收支明細").[A4].Resize(s, 5) = Application.Transpose(Application.Transpose(AY))
Workbooks("收支100.xls").Sheets("收支明細").Activate
Application.ScreenUpdating = False
For Y = 4 To ActiveSheet.UsedRange.Rows.Count
If WorksheetFunction.CountA(Rows(Y)) = 0 Then
Rows(Y).EntireRow.Hidden = True
If Y = 72 Then
[ A73].Offset(0, 2).Resize(, 2) = Array("=SUM(R4C:R[-1]C)", "=SUM(R4C:R[-1]C)")
If Y < 72 Then
Else: Exit Sub
End If
End If
End If
Next Y
Application.ScreenUpdating = True
End Sub作者: Hsieh 時間: 2011-10-26 23:28
