运行VBA宏后缺少单元格中的公式

时间：2015-12-25 16:17:47

标签： excel vba excel-vba

在D，E＆amp; D列下的'power'表中。 F有细胞中写的公式;然而，在运行下面的宏（我认为）后，上述公式消失了。这怎么发生的？如何在运行宏时保留原始公式？

Sub ReadData()

Dim i, j, k, obs, n As Integer
Dim value, sum As Double
Dim resultsExist As Boolean

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.StatusBar = "Read Data: Copying data"

' Copy factor values
Sheets("Power").Range("IData").Resize(maxObserv).Clear
Sheets("Data").Select
Rows("1:1").Select
i = FindColumn(Sheets("Data"), Range("Name").value)
If i = 0 Then GoTo Cleanup
Cells(1, i).Select
ActiveCell.Range("A2:A" & maxObserv).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Power").Select
Range(ValuePos).PasteSpecial xlPasteValues
Application.CutCopyMode = False

' Copy default data
Sheets("Data").Select
Range("A2:A" & maxObserv).Select
Selection.Copy
Sheets("Power").Select
Range(DefaultPos).Select
ActiveSheet.Paste
Application.CutCopyMode = False

' Copy segment data
Sheets("Data").Select
j = FindColumn(Sheets("Data"), "ID")
If j > 0 Then
ActiveSheet.Range(Cells(1, j), Cells(maxObserv, j + 3)).Select    ' Change here to adjust sample size
Selection.Copy
Sheets("Power").Select
Range(InfoPos).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If

' Sort data
Application.StatusBar = "Read Data: Sorting"
Sheets("Power").Select
Range("IData").Select
Selection.Sort Key1:=Range(ValuePos), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
obs = 1
value = -9999999
Do Until Cells(obs + 4, 2) = ""
If Cells(obs + 4, 1) <> value Then
  If (n > 1) And (sum > 0) Then
    For k = obs - n To obs - 1
      Cells(k + 4, 2) = sum / n
    Next k
  End If
  n = 1
  value = Cells(obs + 4, 1)
  sum = Cells(obs + 4, 2)
Else
  n = n + 1
  sum = sum + Cells(obs + 4, 2)
End If
obs = obs + 1
Loop

' Retrieve or calculate buckets range
Sheets("Analysis").Select
k = FindColumn(Sheets("Results"), Range("Name").value)
If (k > 0) Then resultsExist = (Sheets("Results").Cells(6, k) <> "") Else resultsExist = False
If resultsExist Then
Application.StatusBar = "Read Data: Retrieving stored results"
Range("loBucket") = Sheets("Results").Cells(11, k)
Range("hiBucket") = Sheets("Results").Cells(12, k)
Range("upperCutoff") = 2.95 / Sheets("Results").Cells(7, k) + Sheets("Results").Cells(6, k)
Range("lowerCutoff") = 2 * Sheets("Results").Cells(6, k) - Range("upperCutoff")
Else
Application.StatusBar = "Read Data: Calculating suggestions"
Calculate
Range("loBucket") = Range("minData")  ' Alternatively one could set this
Range("hiBucket") = Range("maxData")  ' to 5% and 95% percentile
Range("lowerCutoff") = Application.WorksheetFunction.Percentile(Range("Data"), 0.05)
Range("upperCutoff") = Application.WorksheetFunction.Percentile(Range("Data"), 0.95)
End If
Calculate

Cleanup:
Application.CutCopyMode = False
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

新编辑：抱歉，我遗漏了代码明确部分的选项，就像这样 - 

Option Explicit
Const maxObserv As Integer = 30000
Const ValuePos As String = "A5"
Const DefaultPos As String = "B5"
Const InfoPos As String = "C4"

新编辑：FindColumn是一个定义如下的函数 - 

Function FindColumn(searchSheet As Worksheet, colName As String) As Integer

Dim i As Integer

i = 2
Do While searchSheet.Cells(1, i) <> ""
    If searchSheet.Cells(1, i) = colName Then
        FindColumn = i
        Exit Do
    End If
    i = i + 1
Loop

End Function

新编辑：下面是在“ReadData（）”子下面的上述代码之前运行的代码，这可能会影响结果 - 

Sub AdjustModel()

  Dim obs As Integer
  Dim tmpRange As Range

  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  ' Count number of observations in Data sheet
  Sheets("Data").Select
  obs = 1
  Do Until Cells(1 + obs, 1) = "" And Cells(2 + obs, 1) = ""
    obs = obs + 1
  Loop

  ' Adjust names to required length
  ActiveWorkbook.Names("Data").RefersTo = "=Power!$A$5:$A$" & (5 + obs)   ' factor values
  ActiveWorkbook.Names("DData").RefersTo = "=Power!$B$5:$B$" & (5 + obs)  ' default flag
  ActiveWorkbook.Names("LData").RefersTo = "=Scores!$A$5:$A$" & (5 + obs) ' logit values
  ActiveWorkbook.Names("SData").RefersTo = "=Scores!$B$5:$B$" & (5 + obs) ' factor scores
  ActiveWorkbook.Names("PData").RefersTo = "=Power!$T$5:$V$" & (5 + obs)  ' data for power calculation
  ActiveWorkbook.Names("IData").RefersTo = "=Power!$A$5:$F$" & (5 + obs)  ' information data
  Sheets("Power").Names("BData").RefersTo = "=Power!$G$5:$G$" & (5 + obs)   ' bucket number of observation
  Sheets("Scores").Names("BData").RefersTo = "=Scores!$C$5:$C$" & (5 + obs) ' bucket number of observation

  'Adjust formulas to correct length
  Sheets("Power").Range("PData").Formula = Sheets("Power").Range("PData").Rows(1).Formula
  Sheets("Power").Range("BData").Formula = Sheets("Power").Range("BData").Cells(1, 1).Formula
  Sheets("Scores").Range("BData").Formula = Sheets("Scores").Range("BData").Cells(1, 1).Formula
  Sheets("Scores").Range("LData").Formula = Sheets("Scores").Range("LData").Cells(1, 1).Formula
  Sheets("Scores").Range("SData").Formula = Sheets("Scores").Range("SData").Cells(1, 1).Formula

  ' Adjust charts
  Sheets("Analysis").ChartObjects("Chart 1").Chart.SeriesCollection(1).XValues = Range("PData").Columns(1)
  Sheets("Analysis").ChartObjects("Chart 1").Chart.SeriesCollection(1).Values = Range("PData").Columns(2)

  ' Cleanup
  Application.StatusBar = False
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub

1 个答案:

答案 0 :(得分：2)

我只想对你的代码提出一些应该有用的要点。

  1. Avoid using .Select

  2. 使用多个工作表时，始终明确说明工作表（和工作簿，如果适用）。如果你不这样做，这可能会引起很多麻烦，特别是如果使用.Select并且在复印/粘贴的纸张周围弹跳。这可能是您PasteSpecial覆盖所需数据的原因 - 您没有指定应粘贴的工作表。

  3. 在顶部使用Option Explicit，强制您声明所有变量。

  4. 你声明变量的方式并不是你想象的那样。

    5. 我首先从第4点开始。你在做什么

    Dim i, j, k, obs, n As Integer - 我假设您希望将i，j，k等作为整数。只有n被声明为整数...其他是默认值（Variant）。对于每个变量，您需要明确告诉VBA您想要什么类型。因此，请使用Dim i as Integer, j as Integer, k as Integer等。在我的代码中，您会看到我正在Dim i&, j&，&是As Integer的简写。 （有关#的更多信息，请参阅this page，<{1}}

    第3点 - 我不确定As Double变量的设置位置，因此可能会导致粘贴问题。这是ValuePos可以帮助您确保使用您尝试使用的变量的地方。

    第一和第二点包含在我的代码中。我试图按原样保留您的代码，但请注释掉您不需要的内容，并添加了一些我自己的注释。

    我主要担心的是，我不确定您需要的每个范围内的纸张，因此请仔细观察并根据需要进行调整。

    Option Explicit

    我希望这有助于深入了解它。如果没有，我仍然建议尝试分解Option Explicit Sub ReadData() Dim i&, j&, k&, obs&, n& Dim value#, sum# Dim resultsExist As Boolean ' I think you want these as ranges, but change if not. Dim maxObserv As Range, ValuePos As Range, findColumn As Range, defaultPos As Range Dim powerWS As Worksheet, dataWS As Worksheet, analysisWS As Worksheet, resultsWS As Worksheet Dim infoPos As Range Set powerWS = Sheets("Power") Set dataWS = Sheets("Data") Set analysisWS = Sheets("Analysis") Set resultsWS = Sheets("Results") Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.StatusBar = "Read Data: Copying data" ' Copy factor values powerWS.Range("IData").Resize(maxObserv).Clear 'Sheets("Data").Select ' You don't need to use `.select`, you can just work directly with the data. Plus, you never do anything with this selection ' Rows("1:1").Select i = findColumn(dataWS, Range("Name").value) 'If i = 0 Then GoTo Cleanup 'Don't use GoTo, not best practice. Instead just do the following If i = 0 Then Application.CutCopyMode = False Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Exit Sub End If 'Cells(1, i).Select 'ActiveCell.Range("A2:A" & maxObserv).Select 'Application.CutCopyMode = False 'Selection.Copy ' This can be replaced with the below, to avoid using .Select ' I don't know which sheet you wanted, so change the `powerWS` to whatever sheet it should be powerWS.Cells(1, i).Copy powerWS.Range(ValuePos).PasteSpecial xlPasteValues ' WHERE DOES ValuePos come from??? Application.CutCopyMode = False ' Copy default data 'Sheets("Data").Select 'Range("A2:A" & maxObserv).Select 'Selection.Copy dataWS.Range("A2:A" & maxObserv).Copy powerWS.Range(defaultPos).Paste Application.CutCopyMode = False ' Copy segment data j = findColumn(dataWS, "ID") If j > 0 Then With dataWS .Range(.Cells(1, j), .Cells(maxObserv, j + 3)).Copy ' Change here to adjust sample size End With 'Sheets("Power").Select powerWS.Range(infoPos).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End If ' Sort data Application.StatusBar = "Read Data: Sorting" 'Sheets("Power").Select 'Range("IData").Select powerWS.Range("IData").Sort Key1:=powerWS.Range(ValuePos), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom obs = 1 value = -9999999 Do Until powerWS.Cells(obs + 4, 2) = "" With powerWS If .Cells(obs + 4, 1) <> value Then If (n > 1) And (sum > 0) Then For k = obs - n To obs - 1 .Cells(k + 4, 2) = sum / n Next k End If n = 1 value = .Cells(obs + 4, 1) sum = .Cells(obs + 4, 2) Else n = n + 1 sum = sum + .Cells(obs + 4, 2) End If obs = obs + 1 End With Loop ' Retrieve or calculate buckets range 'Sheets("Analysis").Selecth With analysisWS k = findColumn(resultsWS, resultsWS.Range("Name").value) ' What sheet is "Name" on, I assumed the "Results" sheet If (k > 0) Then resultsExist = (resultsWS.Cells(6, k) <> "") Else resultsExist = False If resultsExist Then Application.StatusBar = "Read Data: Retrieving stored results" .Range("loBucket") = Sheets("Results").Cells(11, k) .Range("hiBucket") = Sheets("Results").Cells(12, k) .Range("upperCutoff") = 2.95 / Sheets("Results").Cells(7, k) + Sheets("Results").Cells(6, k) .Range("lowerCutoff") = 2 * Sheets("Results").Cells(6, k) - Range("upperCutoff") Else Application.StatusBar = "Read Data: Calculating suggestions" Calculate .Range("loBucket") = .Range("minData") ' Alternatively one could set this .Range("hiBucket") = .Range("maxData") ' to 5% and 95% percentile .Range("lowerCutoff") = Application.WorksheetFunction.Percentile(.Range("Data"), 0.05) .Range("upperCutoff") = Application.WorksheetFunction.Percentile(.Range("Data"), 0.95) End If End With Calculate 'Cleanup: Application.CutCopyMode = False Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub 的删除并使用显式工作表名称/范围。但同样，如果这是您使用的唯一代码，.Select为空，那么当您粘贴到该范围时，那么......没有范围？您应该为该变量添加一些声明。

    编辑：正如@vacip所提到的，您可以使用 F8 逐步浏览宏，并观察每行的作用。到达ValuePos行时要特别注意。它允许您查看粘贴的位置，因此您可以进行相应的调整。

相关问题
最新问题