在SrchRng中，如果单元格包含数据，则将公式粘贴到右侧

Question

我正在使用Access中的VBA功能来输出电子表格。不幸的是，我没有找到任何在线资源可以帮助我完成我想做的事情。

我的信息输出到列（“ A2：AF”和行）中。 “行”定义信息的最后一行。我在“借阅+1”中有一个公式，用于汇总每一列中的所有内容。

我想搜索（“ C2：AF”＆Lrow）<>“”的单元格，并粘贴一个公式（Offset 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/(???)"

蒂姆·威廉姆斯（Tim Williams）建议添加我的整个代码，因为他的答案的第一行出现错误。我收到错误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