Условный цикл с управлением суммой пропускает значения

Question

я создал этот код с целью:

Первого контур:

• Петля через клетку в column O, чтобы найти все, что начинается с DAAP.
• Если ячейка 5 столбцов слева от DAAP пуста, то добавьте ячейку 1 столбец вправо (это число) до Total. Затем переименовать ячейку GAAF
• Если Клеточные 5 колонок осталось не пусто, то просто переименовать ячейку GAAF

Второй контур:

• Найти все GAAF клетки в column O, а затем изменить ячейка 1 столбец справа от Total

Вот код, который у меня есть, он работает без ошибок, но просто ничего не делает. Я предполагаю, что что-то синтаксически неверно, поэтому он смотрит не в то место, но я не могу его найти! Любая помощь очень ценится :)

Dim rng As Range 
Dim lstRow As Long 
Dim AUMCell As Range 
Dim Total As Long 

lstRow = Cells(Rows.Count, "O").End(xlUp).Row 

Set rng = Range("O2", Cells(lstRow, "O")) 

Total = 0 

For Each AUMCell In rng 
    If AUMCell.value = "DAAP" & "*" And AUMCell.Offset(0, -5).value = "" Then 
     Total = Total + AUMCell.Offset(0, 1).Value 
     AUMCell.value = "GAAF" 
    ElseIf AUMCell.value = "DAAP" & "*" And AUMCell.Offset(0, -5).value <> "" Then 
     AUMCell.value = "GAAF" 
    End If 
Next AUMCell 

For Each AUMCell In rng 
    If AUMCell.Value = "GAAF" Then 
     AUMCell.Offset(0, 1).Value = Total 
    End If 
Next AUMCell 

Answer 1

Хотя код больше выполнение Find будет намного быстрее, чем цикл через каждую ячейку.

Sub Recut() 
    Dim rng1 As Range 
    Dim rng2 As Range 
    Dim rng3 As Range 

    Dim aCell As Range 
    Dim bCell As Range 
    Dim ws As Worksheet 
    Dim SearchString As String 


    Set ws = ActiveSheet 
    Set rng1 = ws.Range("O:O") 

    SearchString = "DAAP" 

    Set aCell = rng1.Find(SearchString, , xlFormulas, xlPart, xlByRows, xlNext) 

    If Not aCell Is Nothing Then 
     Set bCell = aCell 
     If Left$(aCell.Value, 4) = SearchString Then Set rng2 = aCell 
     Do 
      Set aCell = rng1.FindNext(After:=aCell) 
      If Not aCell Is Nothing Then 
       If aCell.Address = bCell.Address Then Exit Do 
       If Left$(aCell.Value, 4) = SearchString Then 
        If Not rng2 Is Nothing Then 
         Set rng2 = Union(rng2, aCell) 
        Else 
         Set rng2 = aCell 
        End If 
       End If 
      Else 
       Exit Do 
      End If 
     Loop 
    Else 
     MsgBox SearchString & " not Found" 
     Exit Sub 
    End If 

    If rng2 Is Nothing Then Exit Sub 

    For Each rng3 In rng2 
     If Len(rng3.Offset(0, -5)) = 0 Then Total = Total + rng3.Offset(0, 1).Value 
     rng3.Value = "GAFF" 
    Next 

    MsgBox Total 

End Sub 

Answer 2

Попробуйте заменить этот код

For Each AUMCell In rng 
    If AUMCell.value = "DAAP" & "*" And AUMCell.Offset(0, -5).value = "" Then 
     Total = Total + AUMCell.Offset(0, 1).Value 
     AUMCell.value = "GAAF" 
    ElseIf AUMCell.value = "DAAP" & "*" And AUMCell.Offset(0, -5).value <> "" Then 
     AUMCell.value = "GAAF" 
    End If 
Next AUMCell 

этим кодом

For Each AUMCell In rng 
    If AUMCell.value like "DAAP*" Then 
     If AUMCell.Offset(0, -5).value = "" Then 
      Total = Total + AUMCell.Offset(0, 1).Value 
     End If   
     AUMCell.value = "GAAF" 
    End If 
Next AUMCell 

PS: К сожалению мой английский