Auswählen von Zellen neben nicht leeren Zellen innerhalb einer Schleife

Question

Ich erstelle einen Flugplan in Excel. Es muss wie folgt aussehen:

Leider Text in diesen nicht leeren Zellen nicht benachbarten Zellen überlappt, da die benachbarten „leeren“ Zellen haben alle Formeln in ihnen (auch wenn der Wert des Formeln ist ""). Beachten Sie, dass jede Spalte eine Stunde Zeit darstellt. So meine Tabelle sieht wie folgt statt:

glaube ich, der einzige Weg, um das Aussehen Ich möchte zu erstellen, ist ein Makro zu schreiben. Der Prozess würde für jede der acht gezeigten Reihen sein, jede Spalte zu durchlaufen und nicht leere Zellen zu identifizieren. Dann für alle solche nicht-leere Zellen, wenn die Zellen einen Flugabbruch darstellen (zB von WUH in blau - ich kann einen Test dafür erstellen, wie wenn die Zelle links davon leer ist), muss ich diese Zelle auswählen und die vier Zellen zu seiner Rechten und dann Merge-and-Link-Rechtfertigung. Wenn die Zellen eine Flugankunft darstellen (z. B. WUH in Rot oder MCO), muss ich die Zelle auswählen, den reinen Wert ihres Inhalts in die Zelle 4 links davon kopieren und dann die Zelle und die vier zu ihrer Rechten auswählen , dann merge-and-right-justify.

Kann mir bitte jemand mit diesem Code helfen, da ich ein kompletter Anfänger in VBA bin? Der Teil, auf den ich die meiste Hilfe brauche, ist die Auswahl eines Bereichs von Zellen neben einer nicht leeren Zelle während des Schleifenprozesses. Hinweis: Ich bin auch ein Anfänger bei Stack Overflow. Wenn ich die Frage nicht richtig gestellt habe, lassen Sie es mich wissen.

Answer 1

FYI, löste ich mein Problem mit dem folgenden Makro:

Sub FormatRotation() 

Application.DisplayAlerts = False 
Application.ScreenUpdating = False 
Dim c As Integer 
Dim r As Integer 

For c = 4 To 362 
'Test if column contains an arrival 
    If Len(Cells(9, c).Text) > 2 And Cells(9, c + 1) = "" Then 
     For r = 9 To 16 
      Cells(r, c).Select 
      Selection.Copy 
      Cells(r, c - 4).Select 
      Selection.PasteSpecial Paste:=xlValues 
     Next r 
     For r = 9 To 16 
      Range(Cells(r, c - 4), Cells(r, c)).Select 
       With Selection 
       .MergeCells = True 
       .HorizontalAlignment = xlRight 
       End With 
     Next r 

    End If 

'Test if column contains a departure 
    If Len(Cells(9, c).Text) > 2 And Cells(9, c + 1) <> "" Then 
     For r = 9 To 16 
      Range(Cells(r, c), Cells(r, c + 4)).Select 
       With Selection 
       .MergeCells = True 
       .HorizontalAlignment = xlLeft 
       End With 
     Next r 
    End If 


Next c 

Application.DisplayAlerts = True 
Application.ScreenUpdating = True 
Calculate 

End Sub