VBA循环按文本搜索,偏移然后递增

时间:2017-05-24 21:18:18

标签: excel vba excel-vba

我一直在寻找超过3天来构建这个我需要的VBA宏所以任何帮助都会非常感激。我想构建一个带有Loop的宏来搜索某些固定文本(这将是我的参考步骤文本)在一列中让我们说它是C列,一旦它发现文本将偏移到B列左边的下一个单元格,这个单元格将有一个我想要复制到下一个单元格的变量文本C的文本步骤。我认为Macro将通过制作双循环,首先循环搜索C列中的文本,一旦发现它将偏移到列B的相邻单元格,然后另一个循环复制&将列B的单元格的值粘贴到C的下一个文本步骤之前,并且将对所有列c执行第一个循环。我试用第一个循环是有些成功的,因为我尝试将其标识为布尔值或使用For Each循环。但是我的困难部分总是在第二个循环中,在列C的下一步之前将列B的文本递增到单元格并将两个循环相互关联。 以下是我的试验,如果你可以帮助我,我将不胜感激。

    Sub test()

    Dim i As Long

    Dim ilastrow As Long

    Dim n As string

    ilastrow = Range("C1").End(xlDown).Row
Dim r As Range, cell As Range
Set r = Range("C1").End(xlDown).Row

For Each cell In r
        If cell.Value = "TH" Then
   ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Activate
n = ActiveCell.Value
'from here I want to copy n down to every cell until before next "TH" in column C then proceed with next "TH" as n will be changed and so on for all "TH" in Colmun C 

End If
    Next
End Sub

what I want to do with picture

任何帮助将非常感谢提前感谢:)

1 个答案:

答案 0 :(得分:0)

这应该做你想要的:

Option Explicit


Sub test()

  Dim sht As Worksheet
  Set sht = ActiveSheet

  With sht
    Dim ilastrow As Long
    ilastrow = .Cells(.Rows.Count, "C").End(xlUp).Row

    Dim r As Range, cell As Range, prevCell As Range
    Set r = .Range("C1:C" & ilastrow)

    Set prevCell = Nothing
    For Each cell In r
      If cell.Value = "TH" Then
        If Not prevCell Is Nothing Then
          prevCell.Offset(1, -1).Resize(cell.Row - prevCell.Row - 1, 1).Value = prevCell.Offset(, -1).Value
          Set prevCell = cell
        Else
          Set prevCell = cell
        End If
      End If
    Next

    ilastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    prevCell.Offset(1, -1).Resize(ilastrow - prevCell.Row, 1).Value = prevCell.Offset(, -1).Value

  End With

End Sub