複雜的Excel VBA宏與循環

我需要一個相當複雜的VBA宏循環爲我已提供的數據集的幫助。數據集作爲一個長列存在數千個不同的條目。複雜的Excel VBA宏與循環

我試過錄制宏，但我在處理它的最好方法是虧本。任何幫助將不勝感激。簡單來說，我需要找到一個術語（即「這是一個測試」），將該單元格複製到新工作表中，然後將72個單元格向上複製並將該單元格中的任何內容複製到新工作表中。

邏輯對VBA宏環路...

掃描通過對於單詞的所有工作表「這是一個測試」
複製該單元到一個新的工作表（例如，A1）
去72個細胞達
複製該小區到新的工作表（例如，B1）

它需要循環通過上述邏輯在所有打開的工作，將結果轉儲到新的工作表中。

再一次感謝我收到的任何幫助。

來源

2010-09-02 Samikon

這是一個開始。你的筆記表明這些詞只會在每張紙上出現一次，並且會有一排72行的單元格。我已經包含了關於檢查這兩個項目的說明，但只是粗略的。

Dim c As Range 
Dim s As Worksheet 
Dim sr As Worksheet ''For results 
Dim r1 As Long ''Row counter 
Dim i As Long ''Incidence counter 
Dim firstAddress As Variant 

''New worksheet for results 
Set sr = ActiveWorkbook.Worksheets.Add 
r1 = 1 

''It might be better to use a named workbook 
For Each s In ActiveWorkbook.Worksheets 
    ''Don't check results sheet 
    If s.Name <> sr.Name Then 
    ''From: http://msdn.microsoft.com/en-us/library/aa195730(v=office.11).aspx 
     With s.UsedRange 
      Set c = .Find("THIS IS A TEST", LookIn:=xlValues, LookAt:=xlWhole) 
      i = 0 
      If Not c Is Nothing Then 
       firstAddress = c.Address 
       sr.Cells(r1, 1) = c.Value 

       If c.Row - 72 > 0 Then 
        sr.Cells(r1, 2) = s.Cells(c.Row - 72, c.Column) 
       Else 
        sr.Cells(r1, 2) = "Error" 
       End If 

       i = 1 
       r1 = r1 + 1 

       Do 
        i = i + 1 
        Set c = .FindNext(c) 
       Loop While Not c Is Nothing And c.Address <> firstAddress 
      End If 
     End With 
    End If 
    Debug.Print s.Name & " found: " & i 
Next

來源

2010-09-02 08:19:59 Fionnuala

複雜的Excel VBA宏與循環

回答

相關問題