Question

我已编辑此问题以发布整个代码。问题是只有工作簿中的活动工作表具有正确的计算。我已经使用我的许多项目工作簿完成了该程序，我发现列中的值...

.Range("AT2").Value = Evaluate("SUMPRODUCT(AQ2:AQ152,AR2:AR152)/SUM(AQ2:AQ152)") 'calculating Fe weighted mean
  .Range("AT2").AutoFill Destination:=.Range("AT2:AT152")
  .Range("AU2").Value = Evaluate("2*SQRT(SUMPRODUCT((AR2:AR152-AT2)^2,$B$2:$B$152)/SUM($B$2:$B$152))/SQRT(COUNT(AQ2:AQ152))") 'calculating Fe weighted std dev
  .Range("AU2").AutoFill Destination:=.Range("AU2:AU152")

  .Range("AV2").Value = Evaluate("SUMPRODUCT(AQ2:AQ152,AS2:AS152)/SUM(AQ2:AQ152)") 'calculating Cr weighted mean
  .Range("AV2").AutoFill Destination:=.Range("AV2:AV152")
  .Range("AW2").Value = Evaluate("2*SQRT(SUMPRODUCT((AS2:AS152-AV2)^2,$B$2:$B$152)/SUM($B$2:$B$152))/SQRT(COUNT(AQ2:AQ152))") 'calculating Cr weighted std dev
  .Range("AW2").AutoFill Destination:=.Range("AW2:AW152")

...正在改变，具体取决于我运行代码的活动工作簿。这4列：AT，AU，AV和AW完全从活动工作表复制到所有其他工作表。此错误传播给其他工作表后面的代码行给出了错误的结果。只有活动工作表才能获得正确的结果。因此，这里的问题是在活动表的4列中存在数字的复制和粘贴，而不是计算要在所有其他表和它们各自的数据中使用的4个等式。我希望这是有道理的。请告诉我如何避免这个问题。

由于

Sub main()
Dim titles() As Variant
Dim ws As Worksheet
Dim wb As Workbook
Dim i As Long
Dim j As Long


Application.ScreenUpdating = False

Set wb = ActiveWorkbook


titles() = Array("Distance (nm)", "Atom Count", "Fe %", "Cr %", "Fe (Weighted Mean)", "Fe (weighted Std error of mean)", "Cr (Weighted Mean)", "Cr(weighted Std error of mean)", "x", "Fe", "x", "Cr", "x", "Fe", "x", "Cr", "Fe Wave", "Fe Amp", "Cr Wave", "Cr Amp")

For Each ws In wb.Sheets

With ws

    .Range(.Cells(1, "AP"), .Cells(ActiveSheet.UsedRange.Rows.Count, "BI")).ClearContents

    For i = 41 + LBound(titles()) To 41 + UBound(titles())

        .Cells(1, 1 + i).Value = titles(i - 41)

    Next i
    .Rows(1).Font.Bold = True

End With



With ws

For i = 2 To 152
    .Cells(i, "AP").Value = .Cells(i, "A").Value 'Copy distance values from col A
Next i

    .Cells(2, "AQ").Value = ""
    .Cells(3, "AQ").Value = ""
For j = 4 To 152
    .Cells(j, "AQ").Value = (1 / 4) * (.Cells(j - 2, "C").Value + 2 * .Cells(j - 1, "C").Value + .Cells(j, "C").Value) 'doing 3 point weight avg for atom counts
Next j

    .Cells(2, "AR").Value = ""
    .Cells(3, "AR").Value = ""
For j = 4 To 152
    .Cells(j, "AR").Value = (1 / 4) * (.Cells(j - 2, "E").Value + 2 * .Cells(j - 1, "E").Value + .Cells(j, "E").Value) 'doing 3 point weight avg for Fe%
Next j

    .Cells(2, "AS").Value = ""
    .Cells(3, "AS").Value = ""
For j = 4 To 152
    .Cells(j, "AS").Value = (1 / 4) * (.Cells(j - 2, "K").Value + 2 * .Cells(j - 1, "K").Value + .Cells(j, "K").Value) 'doing 3 point weight avg for Cr%
Next j

  .Range("AT2").Value = Evaluate("SUMPRODUCT(AQ2:AQ152,AR2:AR152)/SUM(AQ2:AQ152)") 'calculating Fe weighted mean
  .Range("AT2").AutoFill Destination:=.Range("AT2:AT152")
  .Range("AU2").Value = Evaluate("2*SQRT(SUMPRODUCT((AR2:AR152-AT2)^2,$B$2:$B$152)/SUM($B$2:$B$152))/SQRT(COUNT(AQ2:AQ152))") 'calculating Fe weighted std dev
  .Range("AU2").AutoFill Destination:=.Range("AU2:AU152")

  .Range("AV2").Value = Evaluate("SUMPRODUCT(AQ2:AQ152,AS2:AS152)/SUM(AQ2:AQ152)") 'calculating Cr weighted mean
  .Range("AV2").AutoFill Destination:=.Range("AV2:AV152")
  .Range("AW2").Value = Evaluate("2*SQRT(SUMPRODUCT((AS2:AS152-AV2)^2,$B$2:$B$152)/SUM($B$2:$B$152))/SQRT(COUNT(AQ2:AQ152))") 'calculating Cr weighted std dev
  .Range("AW2").AutoFill Destination:=.Range("AW2:AW152")

End With


FindAllMaxima ws 'call on another sub to find the maxima

With ws

For j = 2 To .Cells(Rows.Count, "BB").End(xlUp).Row
If .Cells(j + 1, "BB").Value <> "" Then
.Cells(j, "BF").Value = .Cells(j + 1, "BB").Value - .Cells(j, "BB").Value 'calculate Fe Wavelength
End If
Next j

For j = 2 To .Cells(Rows.Count, "BD").End(xlUp).Row
If .Cells(j + 1, "BD").Value <> "" Then
.Cells(j, "BH").Value = .Cells(j + 1, "BD").Value - .Cells(j, "BD").Value 'calculate Cr Wavelength
End If
Next j

For j = 2 To .Cells(Rows.Count, "BB").End(xlUp).Row
If .Cells(j, "BB").Value <> "" Then
.Cells(j, "BG").Value = .Cells(j, "BC").Value - .Cells(j, "AT").Value 'calculate Fe Amplitude
End If
Next j

For j = 2 To .Cells(Rows.Count, "BD").End(xlUp).Row
If .Cells(j, "BD").Value <> "" Then
.Cells(j, "BI").Value = .Cells(j, "BE").Value - .Cells(j, "AV").Value 'calculate Cr Amplitude
End If
Next j

End With


Next ws


Application.ScreenUpdating = True

End Sub

Answer 1

Sub x()

Dim ws As Worksheet

For Each ws In Worksheets
    With ws
        .Range("A4") = Evaluate("SUM('" & ws.Name & "'!A1:A3)")
        'OR
        .Range("A4").Formula = "=SUM(A1:A3)"
        'Then autofill etc
    End With
Next ws

End Sub

每个工作表

1 个答案: