Рекурсивный список/сортировка с избыточной или отсутствующей ячейкой

Question

Я использую один столбец данных, который содержит несколько причуд. Я включил код VBA ниже деталей моей проблемы.

Пример того, как организован данные:

• ИМЕНИ
• Суда
• офф
• Суд
• офф
• офф
• Суд
• офф

Однако из-за того, как данные были собраны, Суд не всегда указан. Это отбрасывает мои столбцы, когда я переношу данные. VBA, который я написал, пытался исправить это, когда есть экземпляр Offe, если предыдущая ячейка является судом, регулярно печатайте Offe. Если предыдущая ячейка не была судом, распечатайте предыдущий суд (сохраненный как CourtCell), а затем распечатайте Offe и перейдите к следующей ячейке.

Я получаю объект, требуемый для ошибки.

Sub CourtAdder() 

Dim lngRowLast As Long, _ 
lngRowPaste As Long, _ 
lngColOffset As Long 
Dim rngCell As Range, _ 
rngDataSet As Range 
Dim strSourceTab As String, _ 
strOutputTab As String 

'Tab name containing source data. Change to suit. 
strSourceTab = "Sheet1" 
'Tab name for data output. Change to suit. 
strOutputTab = "Sheet2" 

lngRowLast = Sheets(strSourceTab).Cells(Rows.Count, "A").End(xlUp).Row 

'Assumes the original dataset is in Column A and starts at Row 1. Change to suit. 
Set rngDataSet = Sheets(strSourceTab).Range("A1:A" & lngRowLast) 

Application.ScreenUpdating = False 

For Each rngCell In rngDataSet 

    If Left(rngCell.Value, 5) = "Court" Then 
     CourtCell = ActiveCell.Value 
    End If 
    If Left(rngCell.Value, 4) = "Offe" Then 
     If Left(Rng.Cell.Value.Offset(-1, 0), 4) = "Cour" Then 
      lngRowPaste = 27 
      lngColOffset = 1 
     Else 
      ActiveCell.PasteSpecial (xlPasteValues) 
      lngRowPaste = 1 
      lngColOffset = 1 
     End If 
    Else 
     lngRowPaste = lngRowPaste + 1 
     lngColOffset = 1 

    End If 

'  Sheets(strOutputTab).Cells(lngRowPaste, lngColOffset).Value = rngCell.Value' 
'  lngColOffset = lngColOffset + 1 ' 


Next rngCell 

Application.ScreenUpdating = True 


End Sub 

Answer 1

Несколько моментов:

1. Вы физически не езда на велосипеде через ваши чтения клетки так, используя ActiveCell это ничего к CourtCell не спасает.
2. Велоспорт через строки и столбцы, а для вставки не имеет смысла для меня с вашими необработанными данными.
3. Использование PasteSpecial не собирается ничего делать, поскольку вы ничего не скопировали, и здесь ваша ошибка.

---

Я бы структурировать петлю for следующим образом:

lngColOffset = 1 
For Each rngCell In rngDataSet 

    If Left(rngCell.Value, 5) = "Court" Then 
    'if a court field? 

     'save value and don't copy any values 
     CourtCell = rngCell.Value 

    Else 
    'if not a court field? 

     'add last saved court and current offe to out put sheet 
     Sheets(strOutputTab).Cells(1, lngColOffset).Value = CourtCell 
     Sheets(strOutputTab).Cells(2, lngColOffset).Value = rngCell.Value 

     'go to next column to write 
     lngColOffset = lngColOffset + 1 

    end if 

Next rngCell 

Я надеюсь, что это имеет смысл, и я понял. Если нет, я могу помочь больше.