- 帖子
- 52
- 主題
- 13
- 精華
- 0
- 積分
- 119
- 點名
- 0
- 作業系統
- xp
- 軟體版本
- OFFICE 2003
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2010-5-6
- 最後登錄
- 2022-6-7
|
程式碼修改謝謝
Sub 橢圓2_Click()
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 |
-
-
666.gif
(329.05 KB)
-
-
100.rar
(318.87 KB)
|
發表於 2011-10-26 23:11
| 
發表於 2011-10-26 23:28
| 