Durch viele Suchbegriffe blättern und zu einem anderen Blatt passen?

Question

Ich verwende eine dritte Partei, um Daten zu sammeln, um einen monatlichen Bericht zu erstellen. In diesem Beispiel befindet sich der Datenspeicherauszug des Drittanbieters im Blatt "Data" und das Berichtsblatt heißt "Month"

Sheets ("Daten") Dies ist der Datenspeicherauszug von unstrukturierten Daten, die nach Segmenten aufgelistet sind. Dies ist das strukturierte Berichtsblatt

Sheets („Month“)

, die Daten durch das Segment geeignet für den Bericht werden: obwohl die Reihenfolge der Segmente meines Bericht stimmt nicht überein. Die kopierten Daten aus der ‚Daten‘ Blatt wird in Spalten O bis S eingefügt werden

Ich suche eine Schleife zu schreiben, die durch „Data“, finden jedes aufeinanderfolgende Wort in Spalte B „Monat suchen "und fügen Sie die entsprechenden Informationen aus" Daten "in" Monat "ein.

Im Moment habe ich einen langen Code, der funktioniert, aber es ist leicht zu brechen, wenn einer der Segmentnamen ändert. Dies ist ein kleines Stück, das auf Segment konzentriert sich nur 4.

Sub Macro1() 

' Macro1 Macro 
' For post onto StackOverflow 

Dim ws As Worksheet 
Dim qb As Worksheet 
Dim aCell As Range 
Set ws = ThisWorkbook.Sheets("Month") 
Set qb = ThisWorkbook.Sheets("Data") 



'To find Segment 4 
    With ws 
    Set aCell = .Columns(2).Find(What:="Segment 4", LookIn:=xlValues, _ 
       LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=True, SearchFormat:=False) 
    If Not aCell Is Nothing Then 
     aCell.Offset(0, 1).Value = qb.Range("B2") 
    Else 
     MsgBox "Segment 4 Not Found" 
    End If 

qb.Range("B2:F2").Copy 
aCell.Offset(0, 13).Select 
ActiveCell.PasteSpecial 
End With 

End Sub 

Gibt es eine Möglichkeit, ich Schleife durch Spalte B kann in „Monat“ und es auf den Daten in Spalte A entspricht in „Data“ ohne schreiben zu müssen eine Suche für jedes Segment?

Vielen Dank im Voraus für Ihre Eingabe!

Answer 1

Wie über eine For Each Schleife von Daten durch die Spalte A gehen:

Sub Macro1() 

    ' Macro1 Macro 
    ' For post onto StackOverflow 

    Dim ws As Worksheet 
    Dim qb As Worksheet 
    Dim aCell As Range 
    Set ws = ThisWorkbook.Sheets("Month") 
    Set qb = ThisWorkbook.Sheets("Data") 
    qb.Activate 

    Dim dataCell As Variant 
    For Each dataCell In qb.Range(Cells(2, 1), Cells(qb.Cells(qb.Rows.Count, "A").End(xlUp).Row, 1)) 
     With ws 
      Set aCell = .Columns(2).Find(What:=dataCell.Value, LookIn:=xlValues, _ 
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
        MatchCase:=True, SearchFormat:=False) 
      If Not aCell Is Nothing Then 
       Range(aCell.Offset(0, 1), aCell.Offset(0, 5)).Value = Range(dataCell.Offset(0, 1), dataCell.Offset(0, 5)).Value 
      Else 
       MsgBox dataCell.Value & " Not Found" 
      End If 
     End With 
    Next dataCell 
End Sub