时间戳

首页 > 解决方案 > 将范围乘以值将值粘贴到另一个工作表中并还原更改

excel - 将范围乘以值将值粘贴到另一个工作表中并还原更改

问题描述

我有以下代码，它意味着

  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 " & Minute(Now) & "-" & Hour(Now) & AMPM & "-" & Day(Now) & "-" & 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 & 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" & lastrow).Sort key1:=Range("B2:B" & 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 '" & Err.Number & "': " _
        & Err.Description, vbCritical, "Error"
GoTo SafeExit

结束子

标签： excelvba

解决方案

您遗漏了一些父工作表引用，并且没有将新工作表排除在处理之外。我已经更正了这些并根据我自己的风格收紧了代码。

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, "\S\u\m\m\a\r\y 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 & 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 '" & Err.Number & "': " _
            & Err.Description, vbCritical, "Error"
    GoTo SafeExit

End Sub

需要注意的一点是，您编写的代码可以在同一天运行两次，但不能在同一分钟内运行两次。如果您真的想避免在同一天运行两次，则需要进行额外的修改以实现故障安全退出。

推荐阅读