Блог

У меня есть следующий код, он предназначен для

1. значения ячеек K50: AO50 на каждом листе, равные K73:AO73 умноженному на Opex (который является переменным).
2. Вставьте его на новый лист, а затем
3. Вернитесь к листу, с которого были взяты значения, и отмените изменения для всех листов рабочей книги, чтобы значения на каждом отдельном листе оставались нетронутыми.

Код, который я написал первым, выдает ошибку несоответствия типов, а также я не знаю, как отменить изменения в исходных листах.

 Option Explicit

Sub FinalGO()

Application.ScreenUpdating = False
' When using turning ScreenUpdating off, it is wise to use an Error Handler,
' so when an error occurs, it will get turned on again.
On Error GoTo ErrorHandler

Dim ws As Worksheet     ' Current Worksheet
Dim i As Long           ' Row (Cell) Counter
Dim strName As String   ' New Worksheet Name
Dim AMPM As String 'am or pm
Dim Opex As Integer

AMPM = Format(Now, "AM/PM")
Opex = InputBox("What is our incremental Opex ($)?", "Opex")

' Determine New Worksheet Name.
strName = "Summary " amp; Minute(Now) amp; "-" amp; Hour(Now) amp; AMPM amp; "-" amp; Day(Now) amp; "-" amp; Month(Now)

' In This Workbook (The Workbook Containing This Code)
With ThisWorkbook
     ' Check if New Worksheet already exists.
     On Error Resume Next
     Set ws = .Worksheets(strName)
     If Err Then  ' Does NOT exist.
          On Error GoTo 0
        Else      ' DOES exist.
          GoTo AlreadyDoneToday
     End If

     ' Reenable error handling.
     On Error GoTo ErrorHandler

    ' Add a New Worksheet to the last position in This Workbook.
    .Sheets.Add After:=.Sheets(.Sheets.Count)
    ' In the New Worksheet.
    With .Sheets(.Sheets.Count)
        ' Rename New Worksheet. If you already have used this code today,
        ' this line will produce an error. Delete the sheet or...
        .Name = strName
        ' Write to cell A1 in New Worksheet.
        .Cells(1, 1).Value = "Project Name"
        .Cells(1, 2).Value = "NPV"
        .Cells(1, 3).Value = "Total Capex"
        .Cells(1, 4).Value = "Augmentation Cost"
        .Cells(1, 5).Value = "Metering Cost"
        .Cells(1, 6).Value = "Total Opex"
        .Cells(1, 7).Value = "Total Revenue"

        ' Reset Row (Cells) Counter , because 1st already contains a value.
        i = 1
        ' Loop through worksheets of This Workbook (.Parent).
        For Each ws In .Parent.Worksheets
            ' Check the Name of the Current Worksheet.
            Select Case ws.Name
                ' Do Nothing.
                Case "Prices", "Home Page", "Model Digaram", _
                        "Validation amp; Checks", "Model Start-->", _
                        "Input|Assumptions", "Cost Assumption", "Index", "Model Diagram"

                Case Else

                      If ws.Range("I92").Value = "" Then

                            ws.Range("K50:KO50").Value = ws.Range("K73:AO73").Value * Opex

                            ws.Range("k49:AO49").Value = ws.Range("K72:AO72").Value * Opex

                         Else

                            ws.Range("K49:AO49").Value = ws.Range("K72:AO72").Value * Opex

             End If

                    ' Count Rows (Cells).
                    i = i   1
                    ' Write name of Current Worksheet to cell in current
                    ' Row and first column of New Worksheet.
                    .Cells(i, 1).Value = ws.Name
                    If ws.Range("I106").Value = "" Then

                            .Cells(i, 2).Value = ws.Range("I108").Value

                                        Else

                            .Cells(i, 2).Value = ws.Range("I106").Value

                                        End If

                    .Cells(i, 3).Value = ws.Range("AQ39").Value
                    .Cells(i, 4).Value = ws.Range("AQ23").Value
                    .Cells(i, 5).Value = Cells(i, 3).Value - Cells(i, 4).Value
                    .Cells(i, 6).Value = ws.Range("AQ65").Value
                    .Cells(i, 7).Value = ws.Range("AQ95").Value

Cells.Select
Selection.NumberFormat = "$#,##0"
ActiveSheet.Range("B2:G30").Select
Application.CalculateFull



Dim lastrow As Long
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Range("A1:G" amp; lastrow).Sort key1:=Range("B2:B" amp; lastrow), _
order1:=xlDescending, Header:=xlYes



Success:

MsgBox "The operation finished successfully.", vbInformation, "Success"

SafeExit:

Application.ScreenUpdating = True

Exit Sub

AlreadyDoneToday:

MsgBox "You have already done this today.", vbExclamation, "Already done."
GoTo SafeExit

ErrorHandler:

MsgBox "An unexpected error occurred. Error '" amp; Err.Number amp; "': " _
        amp; Err.Description, vbCritical, "Error"
GoTo SafeExit
  

End Sub

Вы пропустили несколько ссылок на родительский лист и не исключили новый лист из обработки. Я исправил это и ужесточил код в соответствии со своим собственным стилем.

 Option Explicit

Sub FinalGO()
    'I disabled this for testing
    'Application.ScreenUpdating = False
    ' When using turning ScreenUpdating off, it is wise to use an Error Handler,
    ' so when an error occurs, it will get turned on again.
    On Error GoTo ErrorHandler

    Dim ws As Worksheet     ' Current Worksheet
    Dim i As Long           ' Row (Cell) Counter
    Dim strName As String   ' New Worksheet Name
    Dim Opex As Long

    Opex = Application.InputBox(prompt:="What is our incremental Opex ($)?", Title:="Opex", Type:=xlNumbers)

    ' Determine New Worksheet Name.
    strName = Format(Now, "Summary nn-hhAM/PM-dd-mm")

    ' In This Workbook (The Workbook Containing This Code)
    With ThisWorkbook

        ' Add a New Worksheet to the last position in This Workbook.
        With .Worksheets.Add(After:=.Sheets(.Sheets.Count))

            ' Rename New Worksheet. This is only an error if run twice within 1 minute.
            On Error GoTo AlreadyDoneToday
            .Name = strName
            On Error GoTo ErrorHandler

            ' Write headers in New Worksheet.
            .Cells(1, 1).Resize(1, 7) = Array("Project Name", "NPV", "Total Capex", "Augmentation Cost", _
                                              "Metering Cost", "Total Opex", "Total Revenue")


            ' Loop through worksheets of This Workbook (.Parent).
            For Each ws In .Parent.Worksheets

                ' Check the Name of the Current Worksheet.
                Select Case ws.Name
                    'don't write THIS worksheet or a few others
                    Case strName, "Home Page", "Model Digaram", "Validation amp; Checks", "Model Start-->", _
                         "Prices", "Input|Assumptions", "Cost Assumption", "Index", "Model Diagram"

                        ' Do Nothing.

                    Case Else

                        ' Count Rows (Cells).
                        i = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row

                        ' Write name of Current Worksheet to cell in current
                        ' Row and first column of New Worksheet.
                        .Cells(i, 1).Value = ws.Name
                        If ws.Range("I106").Value = "" Then
                            .Cells(i, 2).Value = ws.Range("I108").Value
                        Else
                            .Cells(i, 2).Value = ws.Range("I106").Value
                        End If

                        .Cells(i, 3).Value = ws.Range("AQ39").Value
                        .Cells(i, 4).Value = ws.Range("AQ23").Value
                        .Cells(i, 5).FormulaR1C1 = "=rc3-rc4"
                        .Cells(i, 6).Value = ws.Range("AQ65").Value
                        .Cells(i, 7).Value = ws.Range("AQ95").Value
                End Select
            Next ws
        End With
    End With


Success:
    MsgBox "The operation finished successfully.", vbInformation, "Success"

SafeExit:
    Application.ScreenUpdating = True

Exit Sub

AlreadyDoneToday:
    MsgBox "You have already done this minute.", vbExclamation, "Already done."
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Delete
    Application.DisplayAlerts = True
    GoTo SafeExit

ErrorHandler:
    MsgBox "An unexpected error occurred. Error '" amp; Err.Number amp; "': " _
            amp; Err.Description, vbCritical, "Error"
    GoTo SafeExit

End Sub
  

Следует отметить, что написанный вами код может быть запущен дважды в один и тот же день, но не дважды в течение одной минуты. Если вы действительно хотите избежать запуска дважды в один и тот же день, то для безотказного завершения потребуются дополнительные модификации.