在 SrchRng 中，如果單元格包含數據，則將公式粘貼到右側

Question

我正在 Access 中使用 VBA 函數來輸出電子表格。 不幸的是，我沒有在網上找到任何可以幫助我完成我想做的事情的資源。

我的信息在列中輸出（“A2:AF”和 Lrow）。 “Lrow”定義信息的最后一行。 “Lrow +1”是我有一個公式來匯總每列中的所有內容。

我想搜索（“C2：AF”和Lrow）<>“”的單元格並粘貼一個公式（偏移0,1）以將該單元格除以“Lrow +1”中的總數。 例如，在我的圖片中，C4 中有數據（225.060）。 我試圖在 D4 中粘貼一個公式，將 C4 除以 C11（或 Lrow +1，因為每次輸出電子表格時 Lrow 都會發生變化）

這是我到目前為止的代碼，但我被困在公式部分：

Dim SrchRng As Range, Cel As Range
Dim wks As Excel.Worksheet
Set SrchRng = wks.Cells("C2:AF" & Lrow)
For Each Cel In SrchRng
     If Cel.Value <> "" Then
          Cel.Offset(0,1).Value = "=Cel.Value/(???)"

蒂姆威廉姆斯建議我添加我的整個代碼，因為他的答案的第一行出現錯誤。 我收到錯誤 5：無效的過程調用或參數。

Private Sub Command19_Click()
'Export to Excel
Dim rs1 As DAO.Recordset, rs2 As DAO.Recordset, rs3 As DAO.Recordset, rs4 
As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim cnt As Integer
Dim SrchRng As Range, Cel As Range
Dim Lrow As Long, Lrow1 As Long

Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng, rng1 As Excel.Range

Set db = CurrentDb
Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Add
Set wks = wbk.Worksheets(1)
Set rng = wks.Range("A2")

appExcel.Visible = False

cnt = 1

Set qdf = CurrentDb.QueryDefs("qry_Comparison_Bulk")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next

Set rs1 = qdf.OpenRecordset()

For Each fld In rs1.Fields
    wks.Cells(1, cnt).Value = fld.Name
    cnt = cnt + 1
Next fld
Call rng.CopyFromRecordset(rs1, 4000, 26)

qdf.Close
rs1.Close
Set rs1 = Nothing
Set qdf = Nothing

For Colx = 4 To 26 Step 2
Columns(Colx).Insert Shift:=xlToRight
Next

Set SrchRng = wks.Cells("C2:AF" & Lrow)
For Each Cel In SrchRng
If Cel.Value <> "" Then
    Cel.Offset(0, 1).Formula = "=" & Cel.Address & "/" & wks.Cells(Lrow +1, Cell.Column).Address
End If
Next

'Identifies the last row and row beneath it

Lrow = wks.Cells(Rows.Count, "A").End(xlUp).Row
Lrow1 = wks.Cells(Rows.Count, "A").End(xlUp).Row + 1

'Everything below is formatting

With wks.Range("A" & Lrow1, "AF" & Lrow1)
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 16
.HorizontalAlignment = xlRight
End With

With wks.Range("C2:AE" & Lrow)
.NumberFormat = "0.000"
End With

wks.Cells(Lrow1, "C").Formula = "=SUM(C2:C" & Lrow & ")"
wks.Cells(Lrow1, "E").Formula = "=SUM(E2:E" & Lrow & ")"
wks.Cells(Lrow1, "G").Formula = "=SUM(G2:G" & Lrow & ")"
wks.Cells(Lrow1, "I").Formula = "=SUM(I2:I" & Lrow & ")"
wks.Cells(Lrow1, "K").Formula = "=SUM(K2:K" & Lrow & ")"
wks.Cells(Lrow1, "M").Formula = "=SUM(M2:M" & Lrow & ")"
wks.Cells(Lrow1, "O").Formula = "=SUM(O2:O" & Lrow & ")"
wks.Cells(Lrow1, "Q").Formula = "=SUM(Q2:Q" & Lrow & ")"
wks.Cells(Lrow1, "S").Formula = "=SUM(S2:S" & Lrow & ")"
wks.Cells(Lrow1, "U").Formula = "=SUM(U2:U" & Lrow & ")"
wks.Cells(Lrow1, "W").Formula = "=SUM(W2:W" & Lrow & ")"
wks.Cells(Lrow1, "Y").Formula = "=SUM(Y2:Y" & Lrow & ")"
wks.Cells(Lrow1, "AA").Formula = "=SUM(AA2:AA" & Lrow & ")"
wks.Cells(Lrow1, "AC").Formula = "=SUM(AC2:AC" & Lrow & ")"
wks.Cells(Lrow1, "AE").Formula = "=SUM(AE2:AE" & Lrow & ")"
wks.Cells(Lrow1, "B").Formula = "TOTAL (MG)"

With wks.Range("A1:AF1")
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 16
.NumberFormat = "@"
.HorizontalAlignment = xlCenter
.EntireColumn.AutoFit
End With

appExcel.Visible = True


End Sub

在此處輸入代碼

Answer 1

需要設置Formula屬性，並且公式需要可解析

像這樣的東西：

Dim SrchRng As Range, Cel As Range
Dim wks As Excel.Worksheet
Set SrchRng = wks.Range("C2:AF" & Lrow).Cells 'edit: "Cells()" >> "Range()"
For Each Cel In SrchRng
     If Cel.Value <> "" Then
          Cel.Offset(0,1).Formula = _
              "=" & Cel.Address & "/" & wks.Cells(Lrow +1, Cel.Column).address