遞歸列表/排序與冗餘或丟失單元格

Question

我正在使用包含一些怪癖的數據的單列。我已經在我的問題的細節之下包含了VBA代碼。

的數據是如何組織的一個例子：

• NAME
• 法院
• 奧菲
• 法院
• 奧菲
• 奧菲
• 法院
• 奧菲

但是，由於數據收集的方式，法院並不總是列出。一旦轉置數據，這會拋出我的列。我寫的VBA試圖糾正，每當有一個Offe的實例，如果前面的單元格是法院，定期打印Offe。如果以前的單元格不是Court，請打印先前的Court（保存爲CourtCell），然後打印Offe並繼續到下一個單元格。

我收到一個Object Required Error。

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 

我希望這是有道理的，我明白。如果沒有，我可以幫助更多。