Question

在我为VBA编写一些代码的第一次真正尝试中，这就是我想出来的（在我编辑之前有很多有用的评论......）

下面的一个子程序，打开报告并编辑所述报告，接下来将保存为Name + Today's Date（我不知道如何），然后在新工作簿中复制/粘贴数据，然后准确地进行与新文件（IE：FUL7）相同，如果文件存在，则为8次左右。

非常感谢你的帮助...

Sub Test3()

'First test with compiled open and full edit macro

Dim wb As Excel.Workbook
Dim LastRow As Long

'Open a report, delete header/footer rows

Set wb = Workbooks.Open("C:\Users\USER\Downloads\TFR7", False, False)
wb.Sheets(1).Rows("1:5").EntireRow.Delete
wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).EntireRow.Delete
wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).EntireRow.Delete
wb.Sheets(1).Range("J" & Rows.Count).End(xlUp).EntireRow.Delete

'Edit Sheet Font/Size

With Worksheets("Sheet1").Cells.Font
    .Name = "Arial"
    .Size = 9
End With

'Edit Sheet Alignment, etc.

With Worksheets("Sheet1").Cells
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    .HorizontalAlignment = xlRight
    .VerticalAlignment = xlBottom
    .WrapText = False
End With

'Replace 'text to columns' and convert dates to Excel Date Value before 'Paste Values' to remove formula

Columns("L:O").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L2").FormulaR1C1 = "=DATEVALUE(LEFT(RC[4],10))"
Range("L2").Copy Destination:=Range("L2:O2")
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("L2:O" & LastRow).FillDown
Range("P1:S1").Copy Destination:=Range("L1:O1")

Columns("L:O").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"

'Delete old date columns, remove duplicate values (by tracking numbers)

Columns("P:S").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Range("A1:V" & LastRow).RemoveDuplicates Columns:=19, Header:= _
    xlYes

'Select cells with values, turn them blue (because silly people want them blue)

LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
ActiveSheet.Range("A2:V" & LastRow).Select

With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent1
    .TintAndShade = 0.399975585192419
    .PatternTintAndShade = 0
End With

End Sub

VBA打开/编辑/复制报告？ - 编辑/修正

0 个答案: