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

我正在使用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/(???)"

Dim SrchRng As Range，Cel As Range
Dim以Excel格式工作。工作表
设置SrchRng=wks.Cells（“C2:AF”和Lrow）
对于SrchRng中的每个Cel
如果单元格值为“”，则
单元偏移量（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

Private子命令19_Click（）
'导出到Excel
将rs1设置为DAO.Recordset，rs2设置为DAO.Recordset，rs3设置为DAO.Recordset，rs4
As.DAO.Recordset
将qdf设置为DAO.QueryDef
作为DAO.Parameter的Dim prm
作为整数的Dim cnt
尺寸SrchRng As范围，Cel As范围
变暗Lrow为长，Lrow1为长
Dim appExcel作为Excel.Application
将wbk设置为Excel.工作簿
Dim以Excel格式工作。工作表
尺寸rng，rng1为Excel.范围
Set db=CurrentDb
设置appExcel=Excel.Application
设置wbk=appExcel.Workbooks.Add
设置wks=wbk。工作表（1）
设置rng=wks.Range（“A2”）
appExcel.Visible=False
cnt=1
设置qdf=CurrentDb.querydfs（“qry\u比较\u批量”）
对于qdf.参数中的每个prm
prm.Value=Eval（prm.Name）
下一个
Set rs1=qdf.OpenRecordset（）
对于rs1.字段中的每个fld
wks.Cells（1，cnt）.Value=fld.Name
cnt=cnt+1
下一个fld
调用rng.CopyFromRecordset（rs1、4000、26）
关闭
rs1.关闭
设置rs1=无
设置qdf=无
对于Colx=4到26，步骤2
列（Colx）。插入移位：=xlToRight
下一个
设置SrchRng=wks.Cells（“C2:AF”和Lrow）
对于SrchRng中的每个Cel
如果单元格值为“”，则
单元格偏移量（0，1）。公式=“=”&Cel.Address&“/”&wks.Cells（Lrow+1，Cell.Column）。地址
如果结束
下一个
'标识最后一行及其下的行
Lrow=wks.Cells（Rows.Count，“A”）.End（xlUp）.Row
Lrow1=wks.Cells（Rows.Count，“A”）。End（xlUp）。Row+1
'下面的所有内容都是格式设置
带wks.Range（“A”和Lrow1，“AF”和Lrow1）
.Font.Bold=True
.Font.ColorIndex=2
.Interior.ColorIndex=16
.HorizontalAlignment=xlRight
以
工作范围（“C2:AE”和Lrow）
.NumberFormat=“0.000”
以
wks.Cells（Lrow1，“C”）。公式=“=SUM（C2:C”&Lrow&”）
wks.Cells（Lrow1，“E”）.公式=“=SUM（E2:E”&Lrow&”）
wks.Cells（Lrow1，“G”）.公式=“=SUM（G2:G“&Lrow&”）”
wks.Cells（Lrow1，“I”）.公式=“=SUM（I2:I”&Lrow&”）
wks.Cells（Lrow1，“K”）.公式=“=总和（K2:K”&Lrow&”）
wks.Cells（Lrow1，“M”）。公式=“=总和（M2:M”&Lrow&”）
wks.Cells（Lrow1，“O”）.公式=“=SUM（O2:O”&Lrow&”）
wks.Cells（Lrow1，“Q”）。公式=“=SUM（Q2:Q“&Lrow&”）”
wks.Cells（Lrow1，“S”）.公式=“=SUM（S2:S“&Lrow&”）”
wks.Cells（Lrow1，“U”）.公式=“=SUM（U2:U”&Lrow&”）
wks.Cells（Lrow1，“W”）。公式=“=SUM（W2:W”&Lrow&”）
wks.Cells（Lrow1，“Y”）。公式=“=SUM（Y2:Y”&Lrow&”）
wks.Cells（Lrow1，“AA”）.公式=“=SUM（AA2:AA“&Lrow&”）”
wks.Cells（Lrow1，“AC”）。公式=“=SUM（AC2:AC”&Lrow&”）
wks.Cells（Lrow1，“AE”）.公式=“=SUM（AE2:AE“&Lrow&”）”
wks.Cells（Lrow1，“B”）.公式=“总量（MG）”
工作范围（“A1:AF1”）
.Font.Bold=True
.Font.ColorIndex=2
.Interior.ColorIndex=16
.NumberFormat=“@”
.HorizontalAlignment=xlCenter
.全自动装配
以
appExcel.Visible=True
端接头

---

在此处输入代码

您需要设置

公式

属性，并且公式需要可解析

大概是这样的：

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

Dim SrchRng As Range，Cel As Range
Dim以Excel格式工作。工作表
设置SrchRng=wks.Range（“C2:AF”和Lrow）.Cells的编辑：“Cells（）”>>“Range（）”
对于SrchRng中的每个Cel
如果单元格值为“”，则
单元偏移量（0,1）。公式=_
“=”&Cel.Address&“/”&wks.Cells（Lrow+1，Cel.Column）。地址

我可能遗漏了什么。我按照您的示例，以“End if”和“Next”语句结束，但我得到错误5：无效的过程调用或参数。在哪一行？第一行。wks.Cells（“C2:AF”&Lrow）=这是直接来自您的原始帖子：我只提到了您所说的您遇到问题的部分。如果您在其他部分遇到问题，那么您需要发布代码的其余部分。我在整个代码中使用同一行代码，没有任何问题。我将发布我的代码的其余部分。谢谢Tim。

Set SrchRng=wks.Cells（“C2:AF”和Lrow）

应该是

Set SrchRng=wks.Range（“C2:AF”和Lrow）