运行VBAmacros后缺less单元格中的公式
在D栏下面的“权力”表格中，E＆F里面写着公式; 但是，运行下面的macros（我认为）后，上述公式消失。 这怎么发生的？ 如何在运行macros的时候保留原来的公式？
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
我只想对你的代码做一些主要的观点，
- 避免使用。select
-
在使用多个工作表时，始终明确指定工作表（和工作簿，如果适用）。 这可能会导致许多头痛，如果你不这样做，特别是如果使用。select和popup表复制/粘贴。 这可能是你的
PasteSpecial覆盖你想要的数据的一个原因 – 你没有指定它应该粘贴的表单。 -
在顶部使用
Option Explicit来强制你声明所有的variables。 - 你声明variables的方式并没有做你认为的事情。
我将首先从第四点开始。 你在做
Dim i, j, k, obs, n As Integer – 我假设你希望把i ， j ， k等等作为Integer。 只有n被声明为一个整数…其他的是默认的（ Variant ）。 对于每个variables，你需要明确地告诉VBA你想要什么types。 所以，使用Dim i as Integer, j as Integer, k as Integer等等。在我的代码中，你会看到我正在做Dim i&, j& ， &是As Integer简写。 （有关更多信息，请参阅此页面 ，例如# As Double ）
第3点 – 我不确定ValuePosvariables的设置，这可能会导致粘贴问题。 这是Option Explicit可以帮助您确定您正在尝试使用的variables。
第一点和第二点都包含在我的代码中。 我试图离开你的代码，但注释掉你不需要的代码，并且还添加了我自己的一些评论。
我所关心的主要问题是，我不确定你需要的每个范围是什么，所以仔细观察并根据需要进行调整。
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
我希望这有助于达到它的底部。 如果不是，我仍然build议尝试打破删除。select和使用明确的表名/范围。 但是，如果这是你使用的唯一的代码， ValuePos是空的，所以当你去粘贴到这个范围，有没有范围？ 您应该为该variables添加一些声明。
编辑：作为@vacip提到，你可以通过与F8的macros一步，看看每一行。 尤其要注意到PasteSpecial行。 它可以让你看到粘贴在哪里，所以你可以相应地调整。