Как исправить проблему с синхронизацией макросов - PullRequest
Новая
       4

Как исправить проблему с синхронизацией макросов

0 голосов
/ 25 апреля 2019

я написал макрос, который занимает 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 голосов
/ 25 апреля 2019
  • Stop usign Активируйте и выберите
  • Использовать переменные
  • Замените свой предыдущий код для этого, например.

Public sub 

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...