Vba Excel中的宏：如何使用两个相邻单元格的内容（水平）、自动填充和在电子表格中的某个单词处停止

我想在Excel中创建一个宏：

第一：查找具有特定单词的单元格

第二：向下移动一个单元格，向左移动两个单元格（箭头键）（从C列到A列）

第三：选择A列中的单元格和B列中的相邻单元格

第4步：自动使用A列和B列各自的内容填充A列和B列，直到步骤1中同一单词的下一个实例。（重复过程）…这可以在循环中完成吗

---

提前谢谢你

我想这正是你想要的：

Sub stack()
Dim certain_word As String 'this will be your word
Dim count1, count2, count3, count4 As Long 'counts to move through loop

certain_word = "a" 
'if you wanted to find the word "a". you will have to change this
count1 = Application.CountA(Range("A:A"))
'this will find the number of rows, assuming row "A" will provide an accurate count
count2 = 1
count3 = count2 + 1

While count4 < count1
    If Range("C" & CStr(count2)).Value = certain_word Then
        If Range("C" & CStr(count3)) <> certain_word Then
            If Range("B" & CStr(count3)) <> "" Then
                Range("A" & CStr(count3)) = Range("A" & CStr(count2))
                Range("B" & CStr(count3)) = Range("B" & CStr(count2))
            End If
            count3 = count3 + 1
            count4 = count4 + 1
        Else
            count2 = count2 + 1
            count3 = count2 + 1
        End If
    Else
        count2 = count2 + 1
        count3 = count2 + 1
        count4 = count4 + 1
    End If
Wend
End Sub

---

这最终奏效了。从ozgrid的一个好人那里得到的：

子FindAndFill（） Dim firstAdd作为字符串，findWord作为字符串 变暗fCell As范围 第一行变暗，下一行变暗，最后一行变暗

findWord = InputBox("What are we looking for?", "Search word") 
If findWord = "" Then Exit Sub 


Application.ScreenUpdating = False 
With ActiveSheet.Range("C:C") 
    Set fCell = .Find(findWord) 
    If fCell Is Nothing Then 
        MsgBox findWord & " was not found.", vbOKOnly, "Not found" 
        Exit Sub 
    End If 

     'Define our limits
    firstAdd = fCell.Address 
    lastRow = ActiveSheet.UsedRange.Rows.Count 

    Do 
        firstRow = fCell.Row 
        Set fCell = .FindNext(fCell) 
        If fCell.Address = firstAdd Then 
            nextRow = lastRow 
        Else 
            nextRow = fCell.Row - 1 
        End If 
        Range(Cells(firstRow + 1, "A"), Cells(nextRow, "B")).FillDown 
    Loop Until nextRow = lastRow 
End With 


Application.ScreenUpdating = True 

---

End Sub

这不是代码编写服务。你能展示一下你为解决这个问题做了什么吗？

findWord = InputBox("What are we looking for?", "Search word") 
If findWord = "" Then Exit Sub 


Application.ScreenUpdating = False 
With ActiveSheet.Range("C:C") 
    Set fCell = .Find(findWord) 
    If fCell Is Nothing Then 
        MsgBox findWord & " was not found.", vbOKOnly, "Not found" 
        Exit Sub 
    End If 

     'Define our limits
    firstAdd = fCell.Address 
    lastRow = ActiveSheet.UsedRange.Rows.Count 

    Do 
        firstRow = fCell.Row 
        Set fCell = .FindNext(fCell) 
        If fCell.Address = firstAdd Then 
            nextRow = lastRow 
        Else 
            nextRow = fCell.Row - 1 
        End If 
        Range(Cells(firstRow + 1, "A"), Cells(nextRow, "B")).FillDown 
    Loop Until nextRow = lastRow 
End With 


Application.ScreenUpdating = True