KUMI
Bụi phấn
- Tham gia
- 17/1/12
- Bài viết
- 564
- Được thích
- 571
Xin Chào mọi người!
Em mới tạo 1 đoạn code dưới đây, nhưng mà nó chạy lâu quá!
Mong được các chuyên gia xem và giúp đỡ xem có thể thay thế bằng đoạn mã nào ngắn gọn hơn hay là lược bỏ bớt phần nào.
Để đảm bảo code vẫn hoạt động đầy đủ như nội dung của đoạn code bên dưới và ngắn gọn nhanh chóng.
Xin cám ơn!
Em mới tạo 1 đoạn code dưới đây, nhưng mà nó chạy lâu quá!
Mong được các chuyên gia xem và giúp đỡ xem có thể thay thế bằng đoạn mã nào ngắn gọn hơn hay là lược bỏ bớt phần nào.
Để đảm bảo code vẫn hoạt động đầy đủ như nội dung của đoạn code bên dưới và ngắn gọn nhanh chóng.
Xin cám ơn!
PHP:
Sub CreFile()
Application.SheetsInNewWorkbook = 14
Application.ScreenUpdating = False
Workbooks.Add
Application.SheetsInNewWorkbook = 3
Sheets(1).Name = "A"
Sheets(2).Name = "B"
Sheets(3).Name = "C"
Sheets(4).Name = "D"
Sheets(5).Name = "E"
Sheets(6).Name = "F"
Sheets(7).Name = "G"
Sheets(8).Name = "H"
Sheets(9).Name = "I"
Sheets(10).Name = "J"
Sheets(11).Name = "K"
Sheets(12).Name = "N"
Sheets(13).Name = "M"
Sheets(14).Name = "N"
ThisWorkbook.Activate
Application.StatusBar = "Dang tao file, xin vui long cho trong it phut ...!"
Sheets(1).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(1).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(1).[B2].FormulaR1C1 = "A"
ThisWorkbook.Activate
Sheets(2).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(2).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(2).[B2].FormulaR1C1 = "B"
ThisWorkbook.Activate
Sheets(3).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(3).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(3).[B2].FormulaR1C1 = "C"
ThisWorkbook.Activate
Sheets(4).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(4).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(4).[B2].FormulaR1C1 = "D"
ThisWorkbook.Activate
Sheets(5).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(5).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(5).[B2].FormulaR1C1 = "E"
ThisWorkbook.Activate
Sheets(6).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(6).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(6).[B2].FormulaR1C1 = "F"
ThisWorkbook.Activate
Sheets(7).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(7).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(7).[B2].FormulaR1C1 = "G"
ThisWorkbook.Activate
Sheets(8).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(8).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(8).[B2].FormulaR1C1 = "H"
ThisWorkbook.Activate
Sheets(9).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(9).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(9).[B2].FormulaR1C1 = "I"
ThisWorkbook.Activate
Sheets(10).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(10).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(10).[B2].FormulaR1C1 = "J"
ThisWorkbook.Activate
Sheets(11).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(11).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(11).[B2].FormulaR1C1 = "K"
ThisWorkbook.Activate
Sheets(12).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(12).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(12).[B2].FormulaR1C1 = "L"
ThisWorkbook.Activate
Sheets(13).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(13).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(13).[B2].FormulaR1C1 = "M"
ThisWorkbook.Activate
Sheets(14).[A5:AV207].Copy
ActiveWindow.ActivateNext
Sheets(14).[B3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Sheets(14).[B2].FormulaR1C1 = "N"
Application.CutCopyMode = False
N = 0
For Each Sheet In Sheets()
N = N + 1
Sheets(N).Activate
With ActiveSheet
With .[B1:HA50].Font
.Name = ".VnTime"
.Size = 12
.ColorIndex = 1
End With
With .[B3:HA50]
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
End With
.[B3:HA50].Borders(xlDiagonalDown).LineStyle = xlNone
.[B3:HA50].Borders(xlDiagonalUp).LineStyle = xlNone
With .[B3:HA50].Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .[B3:HA50].Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .[B3:HA50].Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .[B3:HA50].Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .[B3:HA50].Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .[B3:HA50].Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.[B1].FormulaR1C1 = "='TONG HOP.xlsb'!DateMoney" '(Name)
.[B1].Calculate
.[B1].Copy
.[B1].PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
.[1:2,5:7,40:40,44:44,50:50].Font.Bold = True
.[B:B].Columns.AutoFit
.[C:C].ColumnWidth = 10
.[D:HA].ColumnWidth = 28
.[1:50].RowHeight = 16
.[35:35,41:41].EntireRow.Hidden = True
.[B5:HA7,B44:HA44,B50:HA50].Interior.Color = 16777164
.[D6:HA6].SpecialCells(4).EntireColumn.Delete
.PageSetup.PrintArea = "$B$3:$H$50"
With .PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = "$B:$C"
End With
With .PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlOverThenDown
.Zoom = 100
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
End With
.PageSetup.PrintArea = .UsedRange.Address
Range("D4").Select
End With
ActiveWindow.FreezePanes = True
Range("B3").Select
Next
Sheets(1).Select
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs ThisWorkbook.Path & ("\FileCon.xlsx")
ThisWorkbook.Activate
Application.DisplayAlerts = True
Sheets(4).Select
Range("A5").Select
Application.StatusBar = ""
ActiveWindow.ActivateNext
End Sub
Lần chỉnh sửa cuối:
21/12/2012
