|
Sub TEST()
Dim arr, brr, i&, j&, iRow&, R&, strFileName$
Application.ScreenUpdating = False
With Range("A1").CurrentRegion
arr = Intersect(.Offset(), .Offset(3))
End With
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) + 2)
strFileName = GetDesktopPath & "台帐.xlsx"
Workbooks.Open (strFileName)
iRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
R = iRow - 3
For i = 1 To UBound(arr)
R = R + 1
brr(i, 1) = R: brr(i, 2) = Format(Now(), "yyyy.m.d")
For j = 1 To UBound(arr, 2)
brr(i, j + 2) = WorksheetFunction.Round(arr(i, j), 2)
Next j
Next i
Cells(iRow, 1).Resize(UBound(brr), UBound(brr, 2)) = brr
With [a1].CurrentRegion
.HorizontalAlignment = xlCenter
.Borders.LineStyle = xlContinuous
.EntireColumn.AutoFit
.EntireRow.AutoFit
End With
ActiveWorkbook.Close True
Application.ScreenUpdating = True
Beep
End Sub
Function GetDesktopPath()
GetDesktopPath = CreateObject("Wscript.Shell").specialfolders("Desktop") & "\"
End Function
|
评分
-
1
查看全部评分
-
|