Sub ¾ò¶ê2_Click()
Dim Ar(), AY(), AX(), D As Object
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
fd = .SelectedItems(1)
If .ButtonName = "½T©w" 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")¥i°õ¦æ¦ý¸ê®Æ§¨¤º¤u§@ªíÀɦW¥i¥H¬O9©Î¥L¤£©w¡A¦p¦óÅýc»P¤u§@ªí¦P
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 |