Thema Datum  Von Nutzer Rating
Antwort
Rot Rückwärtsschlaufe durch Areas
02.02.2024 11:48:25 BOY
NotSolved
02.02.2024 12:20:16 Mase
NotSolved
02.02.2024 13:33:53 BOY
NotSolved
02.02.2024 15:05:03 Mase
NotSolved
02.02.2024 16:42:18 Mase
NotSolved

Ansicht des Beitrags:
Von:
BOY
Datum:
02.02.2024 11:48:25
Views:
512
Rating: Antwort:
  Ja
Thema:
Rückwärtsschlaufe durch Areas

Hallo zusammen
 

Ich habe mir im Excel einen VBA Code geschireben der folgendes machen soll. Alle Zellen in einer Range speichern welche die Bedingung im ersten Makros  erfüllen (siehe Code unten). Diese Zellen können einzelne oder zusammenhängende Zellen sein, wild verteilt über das ganze Arbeitsblatt. Ich möchte nun abhängig vom VerschiebenWert diese einzelnen Areas rückwärts oder vorwärts durchlaufen. Vorwärts klappt ohne Problem. Rückwärts (rechts nach links) geht jedoch nicht. Wichtig: Ich möchte die Areas als gesamtes bearbeiten und nicht jede Zelle einzeln. Also sprich Zellen die an keine zutreffende Zellen angrenzen werden einzeln angewählt, zusammenhängende Zellen werden als Range angewählt. Könnt ihr mir helfen warum das nicht klappt?

Als Beispiel wie die Rückwärtsschlaufe sein müsste: Die grünen Zellen sind jene die bei der die Bedingung zutreffen würden. Die Zahlen bedeuten welche Zellen zusammen in welcher Reihenfolge markiert werden sollen. 

            2 2 2           1 1 1                
      4         3 3 3                            
                                                 
            6 6 6                 5              
  9 9 9                     8 8           7 7 7  
                                                 

 

Code:
Das cellArea.Select ist eigentlich nur eine Zwischenkontrolle, danach möchte ich mit den einzelnen Areas ein weiteres Makros ausführen. Auch das area.Select ist nur eine Zwischenkontrolle. Bei der Rückwärtsschlaufe ist es so, dass es jeweils in der ersten Zeile klappt, aber ab der zweiten Zeile jedoch nicht mehr. Um entweder die vorwärts oder rückwärtsschlaufe auszulösen könnt ihr einfach bei VerschiebenWert = -3 die Zahl anpassen.
 

Option Explicit
'funktioniert
Sub ZeitlböckeSuchen()
    Dim selectedRange As Range
    Dim currentRow  As Range
    Dim cell        As Range
    Dim cellsToExecute As Range
    VerschiebenWert = -3
    ' Überprüfen, ob ein Bereich ausgewählt ist
    If TypeName(Selection) <> "Range" Then
        MsgBox "Bitte wählen Sie einen Zellbereich aus, bevor Sie den Code ausführen.", vbExclamation
        Exit Sub
    End If
    
    ' Den ausgewählten Bereich speichern
    Set selectedRange = Selection
    
    ' Durch jede Zeile im ausgewählten Bereich iterieren
    For Each currentRow In selectedRange.Rows
        ' Range für die aktuellen Zellen in der Zeile erstellen
        Set cellsToExecute = Nothing
        
        For Each cell In currentRow.Cells
            ' Überprüfen, ob die Zelle die angegebene Farbe oder den angegebenen Wert hat
            If cell.Interior.Color <> RGB(242, 242, 242) Or cell.Value = ChrW(9670) Then
                If cellsToExecute Is Nothing Then
                    Set cellsToExecute = cell
                Else
                    Set cellsToExecute = Union(cellsToExecute, cell)
                End If
            End If
        Next cell
        
        ' Überprüfen, ob es Zellen zum Ausführen gibt
        If Not cellsToExecute Is Nothing Then
            
            ZeitblöckeEinzelnDurchlaufen cellsToExecute
            
        End If
    Next currentRow
End Sub
'code zum anpassen
Sub ZeitblöckeEinzelnDurchlaufen(Zeitblock As Range)
    'Dim selectedRange As Range
    Dim area        As Range
    Dim row         As Range
    Dim lngArea     As Long
    Dim i           As Integer
    Dim selectedArea As Range
    Dim cellArea    As Range
    
    Zeitblock.Select
    MsgBox "select"
    ' Überprüfen, ob eine Zeitblock vorhanden ist
    If Zeitblock.Count > 0 Then
        ' Durchlaufen der ausgewählten Zeilen
        If VerschiebenWert < 0 Then
            For Each row In Zeitblock.Rows
                ' Durchlaufen der Bereiche (zusammenhängende Zellen) in der Zeile
                For Each area In row
                    ' Anzeigen der Adresse des Bereichs in einer MsgBox
                    area.Select
                    MsgBox "select negativ  " & VerschiebenWert
                Next area
            Next row
        Else
            For Each cellArea In Zeitblock.Rows
                ' Durchlaufe jede Area (Zellenbereich) von rechts nach links
                For i = cellArea.Areas.Count To 1 Step -1
                    ' Setze die aktuelle Area
                    Set selectedArea = cellArea.Cells(1, i)
                    cellArea.Select
                    MsgBox "select positiv" & VerschiebenWert
                    
                Next i
                
            Next cellArea
        End If
    Else
        MsgBox "Es wurden keine Zellen ausgewählt.", vbExclamation
    End If
End Sub

 

Vielen Dank schon jetzt für eure Hilfe:)


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Rückwärtsschlaufe durch Areas
02.02.2024 11:48:25 BOY
NotSolved
02.02.2024 12:20:16 Mase
NotSolved
02.02.2024 13:33:53 BOY
NotSolved
02.02.2024 15:05:03 Mase
NotSolved
02.02.2024 16:42:18 Mase
NotSolved