Excel 用A列中的文本标识该单元格并插入公式

我有一张纸，上面有一个特定的文本，在一个范围内出现一次。我想用A列中的文本标识该单元格，并插入一个公式

我的excel工作表在a列中有一个名为“加权”的文本。该文本的范围在A152:A200之间。我想在范围内识别这个单词，并在第一列中写一个公式。假设这个单词在A162中，相应的I162中的公式应该是I152（这总是相同的）：I161（总是在单词前面一行）

如果单词weighted出现在A160中，则I160中的公式应为sum（I152:I159）。你知道怎么做吗。我已尝试以下代码，但无法继续

Dim ws As Worksheet, sCellVal As String
    Dim Q As Range
Set ws = ActiveSheet

For Each Q In Range("A152:A200")

sCellVal = Q.Text

 If sCellVal Like "*Weighted:*" Then Offset(8,0)

---

请检查我是否理解您的问题：

Dim ws As Worksheet
Dim Q As Range
Set ws = ActiveSheet

For Each Q In ws.Range("A152:A200")

If Q.Value Like "*Weighted:*" Then
    ' Assign a formula to I Column
    ws.Range("I" & Q.Row).Formula = "=SUM(I152:I" & Q.Row - 1 & ")"
    Exit For
End If

Next

请尝试此代码 :

使用Find方法识别单元格

选项显式
子writeFormula（）
Const wsName As String=“Sheet1”
Const FormulaColumn As Variant=“I”
常量标准地址为String=“A152:A200”
常量条件为String=“加权：”
将wb设置为工作簿：设置wb=ThisWorkbook
将ws设置为工作表：设置ws=wb.Worksheets（wsName）
Dim rng As Range:设置rng=ws.Range（标准地址）
暗淡的cel As范围
'不区分大小写，即“W”=“W”：
设置cel=rng.Find（条件、rng.Cells（rng.Rows.Count）、xlValues、xlPart）
'或区分大小写，即“W”“W”：
'设置cel=rng.Find（条件、rng.Cells（rng.Rows.Count）、xlValues、xlPart、_
，对）
如果cel为空，则退出Sub
如果cel=rng.CELL（1），则退出Sub
淡出
Offs=ws.Columns（FormulaColumn）.Column-ws.Range（CriteriaAddress）.Column
设置rng=ws.Range（rng.Cells（1），cel.OffSet（-1））。OffSet（，Offs）
设置单元=单元偏移（，偏移）
cel.Formula=“=SUM（&rng.Address（False，False）&”）
端接头

谢谢。这只需要一个很小的改变就可以很好地工作——如果Q值像“加权”那么我很高兴能帮上忙。请不要忘记承认答案已被接受或有用。谢谢，这很有用。多谢各位

Sub findweighted()
Dim i As Integer

For i = 152 To 200
    DoEvents
        If InStr(Range("a" & i), "Weighted") Or InStr(Range("a" & i), "weighted") Then
        Range("a" & i).Offset(0, 8).Formula = "=sum(i152:i" & i - 1 & ")"
 
    Else
    End If
Next


End Sub

Option Explicit

Sub writeFormula()

    Const wsName As String = "Sheet1"
    Const FormulaColumn As Variant = "I"
    Const CriteriaAddress As String = "A152:A200"
    Const Criteria As String = "Weighted:"
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim rng As Range: Set rng = ws.Range(CriteriaAddress)
    
    Dim cel As Range
    ' Either case-insensitive i.e. "W" = "w":
    Set cel = rng.Find(Criteria, rng.Cells(rng.Rows.Count), xlValues, xlPart)
    ' Or case-sensitive i.e. "W" <> "w":
    'Set cel = rng.Find(Criteria, rng.Cells(rng.Rows.Count), xlValues, xlPart, _
                       , , True)
    If cel Is Nothing Then Exit Sub
    If cel = rng.Cells(1) Then Exit Sub
    
    Dim Offs As Long
    Offs = ws.Columns(FormulaColumn).Column - ws.Range(CriteriaAddress).Column
    
    Set rng = ws.Range(rng.Cells(1), cel.OffSet(-1)).OffSet(, Offs)
    Set cel = cel.OffSet(, Offs)
    
    cel.Formula = "=SUM(" & rng.Address(False, False) & ")"

End Sub