VBA Loop-Suche nach Text, Offset dann inkrementieren

Question

Ich habe mehr als 3 Tage gesucht, um dieses VBA-Makro zu bauen Ich brauche so jede Hilfe wäre viel ich geschätzt.Ich möchte ein Makro mit einem Loop erstellen, die suchen wird für bestimmten festen Text (dies ist mein Referenzschritt Text) in einer Spalte lassen Sie uns sagen, es ist Spalte C, sobald es finden, dass Text auf die nächste Zelle nach links in Spalte B versetzt wird und diese Zelle wird eine variable Text, dass ich möchte ich bis kurz vor den nächsten Textschritt von C kopieren. Ich denke, Macro wird durch doppelte Schleifen, erste Schleife nach dem Text in Spalte C suchen und einmal finden, wird es auf benachbarte Zelle von Spalte B dann eine andere Schleife zu verschieben kopieren Sie & fügen Sie den Wert der Zelle der Spalte B vor dem nächsten Textschritt von C ein, und die erste Schleife wird für alle Spalte c ausgeführt. Mein Versuch mit der ersten Schleife war so erfolgreich, wie ich es versuchte, entweder mit der Bestimmung des bestimmten Textes als Boolean oder mit For Each-Schleife. aber mein schwerer Teil war immer in der zweiten Schleife, um den Text von Spalte B auf die Zelle vor dem nächsten Schritt von Spalte C zu erhöhen und die zwei Schleifen miteinander in Beziehung zu setzen. Unten sind meine Versuche, wenn Sie in ihnen helfen könnten, würde ich sehr geschätzt werden.

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

jede mögliche Hilfe viel Dank im Voraus geschätzt werden :)

Answer 1

Dies tun sollten, was Sie wollen:

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