如何解决宏时序问题

时间：2019-04-25 18:09:43

标签： excel vba

我写了一个在其他计算机上花费20分钟以上的宏，但是当我在我的计算机上运行它时仅花费5分钟。它是一个更大的宏，我对VBA编码世界还是陌生的。我想知道是否可以将其压缩下来，以便它不仅可以在我的计算机上运行，​​还可以在其他计算机上运行得更快。 

Sub Macro1()
Dim i As Integer
Dim r As Long, c As Long

Application.ScreenUpdating = False

  Sheets("CIP Summary").Select
    Sheets.Add

ActiveSheet.Name = "Consolidated"
   ActiveCell.FormulaR1C1 = "Company"
   Range("B1").Select
   ActiveCell.FormulaR1C1 = "Location"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Store"
   Range("D1").Select
   ActiveCell.FormulaR1C1 = "RCT/Voucher"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Vendor"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Vendor Name"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Date"
   Range("H1").Select
   ActiveCell.FormulaR1C1 = "Reference"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Amount"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Period"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "JE"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Project"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Expected Open Date"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Comment"
    Range("N1").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Font.Bold = True

For i = 15 To Worksheets.Count


   For c = 1 To 14
    For r = 5 To 1000
        If IsError(Sheets(i).Cells(r, c)) Then
      Sheets(i).Cells(r, c).Value = "N/A"
        ElseIf Sheets(i).Cells(r, c) = "" Then
        Sheets(i).Cells(r, c).Value = "N/A"
       End If
   Next r
    Next c
Next i

Dim xWs As Worksheet
Dim Rng As Range
Dim lastRow As String
Dim myPath As String

'company
Sheets(15).Select
Set Cell = Range("A1:N4").Find("Company", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("A1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("Company", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i

'location
Sheets(15).Select
Set Cell = Range("A1:N4").Find("location", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("B1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("location", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i

'Store
Sheets(15).Select
Set Cell = Range("A1:N4").Find("store", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("C1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("store", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i

'RCT
Sheets(15).Select
Set Cell = Range("A1:N4").Find("RCT", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("D1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("RCT", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i

'Vendor
Sheets(15).Select
Set Cell = Range("A1:N4").Find("Vendor", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("E1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("Vendor", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i

'Vendor Name
Sheets(15).Select
Set Cell = Range("A1:N4").Find("Vendor Name", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("F1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("Vendor Name", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i

'Date
Sheets(15).Select
Set Cell = Range("A1:N4").Find("date", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("g1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("date", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i

'Reference
Sheets(15).Select
Set Cell = Range("A1:N4").Find("reference", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("H1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("reference", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i

'amount
Sheets(15).Select
Set Cell = Range("A1:N4").Find("amount", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("I1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("amount", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i

'period
Sheets(15).Select
Set Cell = Range("A1:N4").Find("period", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("J1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("period", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i

'JE
Sheets(15).Select
Set Cell = Range("A1:N4").Find("JE", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("K1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("JE", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i

'project
Sheets(15).Select
Set Cell = Range("A1:N4").Find("Project", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("L1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("project", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i

'expected open date
Sheets(15).Select
Set Cell = Range("A1:N4").Find("expected", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("M1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("expected", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i

'comment
Sheets(15).Select
Set Cell = Range("A1:N4").Find("comment", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Range("N1").Select
    Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("comment", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
    Worksheets("Consolidated").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

Next i




End Sub

任何帮助都会很好。由于我是新手，因此花了我更长的时间才能创建此代码。谢谢你！

1 个答案:

答案 0 :(得分：0)

  • 停止使用激活并选择
  • 使用变量
  • 例如，为此替换您以前的代码。

公共子

Dim i As Integer
Dim r As Long, c As Long
Dim contMax As Long
Dim newSheet As Worksheet


Application.ScreenUpdating = False

  Set newSheet = Sheets.Add


   With newSheet
        .Name = "Consolidated"
        .Range("A1:N1").Value2 = Array("Company", _
                                "Location" _
                                , "Store" _
                                , "RCT/Voucher", _
                                , "Vendor", _
                                "Vendor Name" _
                                , "Date" _
                                , "Reference" _
                                , "Amount" _
                                , "Period" _
                                , "JE" _
                                , "Project" _
                                , "Expected Open Date" _
                                , "Comment")
     .Range("A1:N1").Font.Bold = True
    End With
相关问题
最新问题