Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1380to1384
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bereich erweitern

Bereich erweitern
06.09.2014 22:16:48
werner

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

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bereich erweitern
07.09.2014 03:50:17
Adis
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

Anzeige
AW: Bereich erweitern
07.09.2014 09:42:39
Hajo_Zi
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

Anzeige
AW: Bereich erweitern
07.09.2014 09:43:17
Hajo_Zi
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

Anzeige
AW: Bereich erweitern
07.09.2014 11:58:39
Gerd L
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

Anzeige
AW: Bereich erweitern
07.09.2014 20:11:09
Werner
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige