Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Frame
BildScreenshot zu Frame Frame-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema RefEdit
BildScreenshot zu RefEdit RefEdit-Seite mit Beispielarbeitsmappe aufrufen

Bereich erweitern

Betrifft: Bereich erweitern von: werner
Geschrieben am: 06.09.2014 22:16:48

Hallo zusammen,

ich habe folgendes Makro,das soweit gut funktioniert.

Private Sub Worksheet_Change(ByVal Target As Range)


If Intersect(Target, Range("W:W")) Is Nothing Then Exit Sub
If Intersect(Target, Range("3:16")) Is Nothing Then Exit Sub

    
    Dim s$, i%, j%  Integer (%)
    Dim varBereich As Variant
   
    varBereich = Range("W3:W16")
    
    
    For i = 1 To UBound(varBereich, 1)
        'Innere Schleife über die Spalten des Bereichs
        For j = 1 To UBound(varBereich, 2)
            If Not IsEmpty(varBereich(i, j)) Then   
                s = s & varBereich(i, j) & "         "      
            End If
        Next j
        s = Left(s, Len(s) - 1) & vbLf  
    Next i
    
    On Error Resume Next   fortfahren. ( _
ist das so gewollt?)
    With Sheets("Tabelle1").Cells(1, 12) stehen soll
        .Comment.Delete             
        If s = "" Then Exit Sub     
        .AddComment                
        .Comment.Text Text:=s      
        .Comment.Shape.TextFrame.AutoSize = True   automatisch anpassen
    End With
    
End Sub


Nun möchte ich den Auswahlbereich erweitern:

Bisher geht es um den Bereich W3:W16
Nun möchte ich den Bereich X3:X9 hinzufügen.

Meine Frage ich, wie müsste ich den Bereich in das Makro einsetzen.

Über eine Lösung würde ich mich freuen.

Gruß
Werner

  

Betrifft: AW: Bereich erweitern von: Adis
Geschrieben am: 07.09.2014 03:50:17

Hallo

Bei der Target Auswertung muss zuerst die Spalte X mit ausgewertet werden. Bitte Probieren ob es geht.
Weil offensichtlich dasselbe Programm aufgerufen werden soll würde ich mit -GoSuub- arbeiten.
Das Wort muss mit 1x -u- geschrieben werden, (bitte aendern). Ich habe den Server ausgetrickst!

Weil das Programm 2x abgearbeitet werden soll benutze ich bei den Aufgaben GoSuub als Unterprogramm.
In dem Fall muss am Ende der For Next Schleife für den Rücksprung ein -Return- eingefügt werden,
Dann wird das Programm mit dem veraenderten varBereich erneut aufgerufen. Das Ende erfolgt über Exit Sub.
Es können weitere varBereich aufgerufen werden. Wichtig ist das -Exit Sub- nach dem letzten GoSuub.

If Intersect(Target, Range("3:16")) Is Nothing Then Exit Sub
If Intersect(Target, Range("W:W")) Is Nothing Then
If Intersect(Target, Range("X:X")) Is Nothing Then Exit Sub
End If

varBereich = Range("W3:W16"): GoSuub Schleife
varBereich = Range("X3:X9"): GoSuub Schleife
exit sub 'Ende des Hauptprogramm

Schleife: 'wird als Unterprogramm verwendet
For i = 1 To UBound(varBereich, 1)
Next i
Return 'Rücksprung nach oben

Gruss Adis


  

Betrifft: AW: Bereich erweitern von: Hajo_Zi
Geschrieben am: 07.09.2014 09:42:39

Hallo Werner,

Option Explicit                                     ' Variablendefinition erforderlich

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RaBereich As Range                          ' Variable für Bereich
    Dim RaZelle As Range                            ' Variable für Zelle
    Set RaBereich = Range("L22:M39, O21:O26")       ' Bereich der Wirksamkeit
    ' noch mehr Bereiche
    'Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17"), _
    '    Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49"), _
    '    Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81"), _
    '    Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111"), _
    '    Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139"), _
    '    Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163"), _
    '    Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191"))
    ' Zelle die in dem Bereich liegen auf die Variable schreiben
    ' damit werden nur noch die Zellen bearbeitet die im vorgegeben Bereich liegen
    ' jede Zelladresse ist einzeln angegeben
    Set RaBereich = Intersect(RaBereich, Range(Target.Address))
    If Not RaBereich Is Nothing Then
        'ActiveSheet.Unprotect ("Passwort")
        Application.EnableEvents = False
        For Each RaZelle In RaBereich
            With RaZelle
                ' Deimne Aktion in der Zelle
            End With
        Next RaZelle
        'ActiveSheet.protect ("Passwort")
        Application.EnableEvents = True
    End If
    Set RaBereich = Nothing                         ' Variable leeren
End Sub
GrußformelHomepage


  

Betrifft: AW: Bereich erweitern von: Hajo_Zi
Geschrieben am: 07.09.2014 09:43:17

Hallo Werner,

Option Explicit                                     ' Variablendefinition erforderlich

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RaBereich As Range                          ' Variable für Bereich
    Dim RaZelle As Range                            ' Variable für Zelle
    Set RaBereich = Range("L22:M39, O21:O26")       ' Bereich der Wirksamkeit
    ' noch mehr Bereiche
    'Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17"), _
    '    Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49"), _
    '    Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81"), _
    '    Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111"), _
    '    Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139"), _
    '    Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163"), _
    '    Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191"))
    ' Zelle die in dem Bereich liegen auf die Variable schreiben
    ' damit werden nur noch die Zellen bearbeitet die im vorgegeben Bereich liegen
    ' jede Zelladresse ist einzeln angegeben
    Set RaBereich = Intersect(RaBereich, Range(Target.Address))
    If Not RaBereich Is Nothing Then
        'ActiveSheet.Unprotect ("Passwort")
        Application.EnableEvents = False
        For Each RaZelle In RaBereich
            With RaZelle
                ' Deimne Aktion in der Zelle
            End With
        Next RaZelle
        'ActiveSheet.protect ("Passwort")
        Application.EnableEvents = True
    End If
    Set RaBereich = Nothing                         ' Variable leeren
End Sub
GrußformelHomepage


  

Betrifft: AW: Bereich erweitern von: Gerd L
Geschrieben am: 07.09.2014 11:58:39

Hallo Werner!

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim Rabenreich As Range
    Dim s$, i%, j%, k%  'Integer (%)
    Dim varBereich(1 To 2) As Variant
    
    Set Rabenreich = Union(Range("W3:W16"), Range("X3:X9"))
    
    If Intersect(Target, Rabenreich) Is Nothing Then Exit Sub

   
    varBereich(1) = Range("W3:W16")
    varBereich(2) = Range("X3:X9")
    
    
    For k = 1 To 2
    
    For i = 1 To UBound(varBereich(k), 1)
        'Innere Schleife über die Spalten des Bereichs
        For j = 1 To UBound(varBereich(k), 2)
            If Not IsEmpty(varBereich(k)(i, j)) Then
                s = s & varBereich(k)(i, j) & "         "
            End If
        Next j
        If s <> "" Then s = Left(s, Len(s) - 1) & vbLf
    Next i
    
    Next k
 
    With Sheets("Tabelle1").Cells(1, 12) 'stehen soll
        If Not .Comment Is Nothing Then .Comment.Delete
        If s = "" Then Exit Sub
        .AddComment
        .Comment.Text Text:=s
        .Comment.Shape.TextFrame.AutoSize = True  ' automatisch anpassen
    End With
    
End Sub
Gruß Gerd


  

Betrifft: AW: Bereich erweitern von: Werner
Geschrieben am: 07.09.2014 20:11:09

Hallo zusammen,

herzlichen Dank für Eure Antworten.
Die Lösung von Gerd hat funktioniert, aber auch für die anderen Antworten herzlichen Dank.

Gruß
Werner


 

Beiträge aus den Excel-Beispielen zum Thema "Bereich erweitern"