Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1728to1732
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

Range verändern und in verschiedenen Bereichen aufteilen

Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 19:59:57
Niko
Hallo an alle,
Bräuchte eine “Kleine“ Hilfe wenn jemand Zeit hat :-)
Möchte denn Range verändern und in verschiedenen Bereichen aufteilen, doch gewusst wie!
Anstatt Range("A10:BA441") möchte ich das es in unterschiedlich Zeilen Bereiche aufgeteilt wird.
Wie gesagt statt ("A10:BA441") zur (“A10:BA20“), (“A25:BA35), (“A42:BA44“), etc. bis BA441.
Danke im voraus für jede Hilfe
Anbei der VBA Code:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Unprotect "s0nne"
With Range("A10:BA441").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.PatternTintAndShade = 1
End With
If Not Intersect(Target, Range("A9:BA441")) Is Nothing Then
With Range(Cells(Target.Row, 1), Cells(Target.Row, 54)).Interior
.Pattern = xlGray25
.PatternThemeColor = xlThemeColorAccent2
.PatternTintAndShade = 0.399945066682943
End With
Application.EnableEvents = False
Target.Activate
Application.EnableEvents = True
End If
Protect "s0nne"
End Sub

22
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 20:34:50
Werner
Hallo,
z.B so:
Dim bereich As Range
Set bereich = Range("A10:BA20,A25:BA35,A42:BA44")
With bereich.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.PatternTintAndShade = 1
End With
Und hier dann:
If Not Intersect(Target, bereich) Is Nothing Then
Gruß Werner
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 20:38:33
Nepumuk
Hallo Niko,
im Prinzip so:
Range("A10:BA20,A25:BA35,A42:BA44, .....")

Wobei es eine Begrenzung gibt. Ich glaube mich daran zu erinnern dass bei 1024 Zeichen Schluss ist. Dann müsste man das Ganze per Union-Methode zusammenbauen.
Gruß
Nepumuk
Anzeige
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 20:55:21
Niko
Ohh man...ärgere mit mir selbst...wie groß muss die Leitung sein...in der ich draufsitze?
Irgendetwas haben mir die Feiertage angetan, das ich dauernd auf dem Schlauch sitze…kann es der Wein sein? :-) :-)
Man sagt “in vino veritas” , doch stimmt net…. “In Herbers Forum Veritas“ passt besser :-)
Habe es dauernd mit
- If Not Intersect(Target, Range(“A10:BA20“), (“A25:BA35), (“A42:BA44“)) Is Nothing Then –
versucht und dauernd kam Fehler Meldung.
Jetzt Funktioniertes!!! :-) Danke!
Letzte Frage :-)
With Range("A10:BA441").Interior
Muss ich in diesen Befehl auch denn Range ändern wie bei den Befehl
If Not Intersect(Target, Range(“A10:BA441“)) Is Nothing Then
Danke :-)
Niko
Anzeige
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 21:01:28
Niko
Ups habe die Fußnote von Werner grad gesehen…jetzt ist alle klar….sogar für VBA blinde wie ich :-)
Danke euch beiden und wünsche noch ein guten rutsch :-)
Thx again
Niko
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 21:46:40
Niko
Werner, Nepumuk Hi nochmal :-)
Glaube habe mich zu früh gefreud :-(
Habe es versucht wie Ihr es mir gezeigt habt doch mit beiden Änderungen geht es nicht!
Wenn ich weniger Bereiche eintrage geht es…kann es an den 1024 Zeichen liegen? …wie du es Nepumuk voraussagtest oder mache ich irgendwo ein dummen Fehler?
Sry für das stören, aber brauche weitere Hilfe um es hinzukriegen.
Anbei der VBA Code von Werner, mit Nepumuks code macht es das selbe..stopt bei Range:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim bereich As Range
Unprotect "s0nne"
Set bereich = Range("A12:BA21,A26:BA35,A40:BA49,A54:BA63,A68:BA77,A82:BA91,A96:BA105,A110: _
BA119,A124:BA133,A138:BA147,A152:BA161,A166:BA175,A180:BA189,A194:BA203,A208:BA217,A222:BA231,A236:BA245,A250:BA259,A264:BA273,A278:BA287,A292:BA301,A306:BA315,A320:BA329,A334:BA343,A348:BA357,A362:BA371,A376:BA385,A390:BA399,A404:BA413,A418:BA427,A432:BA441")
With bereich.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.PatternTintAndShade = 1
End With
If Not Intersect(Target, bereich) Is Nothing Then
With Range(Cells(Target.Row, 1), Cells(Target.Row, 53)).Interior
.Pattern = xlGray25
.PatternThemeColor = xlThemeColorAccent2
.PatternTintAndShade = 0.399945066682943
End With
Application.EnableEvents = False
Target.Activate
Application.EnableEvents = True
End If
Protect "s0nne"
End Sub

Danke,
Niko
Anzeige
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 22:05:30
onur
Du dsolltest mal posten, WAS falsch läuft (Fehlermeldung) und vor allem WO GENAU.
"stopt bei Range" ist nixsagend, da Range merhrmals vorkommt.
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 22:09:17
Niko
hast recht...es kommt MEHRMALS...
zwei mal... und bei genauen hinschauen geht es um
Range("A12:BA21,A26:BA35,A40:BA49,A54:BA63,A68:BA77,A82:BA91,A96:BA105,A110: _
BA119,A124:BA133,A138:BA147,A152:BA161,A166:BA175,A180:BA189,A194:BA203,A208:BA217,A222:BA231,A236:BA245,A250:BA259,A264:BA273,A278:BA287,A292:BA301,A306:BA315,A320:BA329,A334:BA343,A348:BA357,A362:BA371,A376:BA385,A390:BA399,A404:BA413,A418:BA427,A432:BA441")
Danke
Anzeige
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 22:11:36
onur
Range("A12:BA21,"A26:BA35" usw usw.
Alle Bereiche EINZELN in Gänsefüsschen.
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 22:11:19
Niko
Range mit Bold um es noch verständlicher zu zeigen
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim bereich As Range
Unprotect "s0nne"
Set bereich = Range("A12:BA21,A26:BA35,A40:BA49,A54:BA63,A68:BA77,A82:BA91,A96:BA105, _
A110:BA119,A124:BA133,A138:BA147,A152:BA161,A166:BA175,A180:BA189,A194:BA203,A208:BA217,A222:BA231,A236:BA245,A250:BA259,A264:BA273,A278:BA287,A292:BA301,A306:BA315,A320:BA329,A334:BA343,A348:BA357,A362:BA371,A376:BA385,A390:BA399,A404:BA413,A418:BA427,A432:BA441")
With bereich.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.PatternTintAndShade = 1
End With
If Not Intersect(Target, bereich) Is Nothing Then
With Range(Cells(Target.Row, 1), Cells(Target.Row, 53)).Interior
.Pattern = xlGray25
.PatternThemeColor = xlThemeColorAccent2
.PatternTintAndShade = 0.399945066682943
End With
Application.EnableEvents = False
Target.Activate
Application.EnableEvents = True
End If
Protect "s0nne"
End Sub

Anzeige
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 22:30:45
Niko
Leider Helfen auch Gänsefüsschen net...stoppt wieder
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim bereich As Range
Unprotect "s0nne"
Set bereich = Range("A12:BA21", "A26:BA35", "A40:BA49", "A54:BA63", "A68:BA77", "A82:BA91", _
"A96:BA105", "A110:BA119", "A124:BA133", "A138:BA147", "A152:BA161", "A166:BA175", "A180:BA189", "A194:BA203", "A208:BA217", "A222:BA231", "A236:BA245", "A250:BA259", "A264:BA273", "A278:BA287", "A292:BA301", "A306:BA315", "A320:BA329", "A334:BA343", "A348:BA357", "A362:BA371", "A376:BA385", "A390:BA399", "A404:BA413", "A418:BA427", "A432:BA441")
With bereich.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.PatternTintAndShade = 1
End With
If Not Intersect(Target, bereich) Is Nothing Then
With Range(Cells(Target.Row, 1), Cells(Target.Row, 53)).Interior
.Pattern = xlGray25
.PatternThemeColor = xlThemeColorAccent2
.PatternTintAndShade = 0.399945066682943
End With
Application.EnableEvents = False
Target.Activate
Application.EnableEvents = True
End If
Protect "s0nne"
End Sub

Anzeige
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 22:34:54
onur
Nochmal:
WELCHE FEHLERMELDUNG DENN?
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 22:39:21
Niko
Da ich es nicht in ein Modul laufen habe sondern in den Blatt direkt, erscheint der Gelbe Pfeil bei den befehl
Set bereich = Range("A12:BA21", "A26:BA35", "A40:BA49", "A54:BA63", "A68:BA77", "A82:BA91"..........
weiss nicht ob dies weiter helfen tut...aber viel von VBA weiss ich auch net um ganz ehrlich zu sein :-)
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 22:45:13
onur
KEINE FEHLERMELDUNG ?
WAS PASSIERT, WENN DU AUF "DEBUGGEN" KLICKST?
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 22:46:17
Werner
Hallo,
die Beschränkung hat dir Nepumuk doch geschrieben. Du mußt deine Bereiche aufteilen unm dit Union zusammenführen.
set bereich = Range(.......
set bereich1 = Range(.......
set bereich2 = Range(......
set Gesamt = Union(bereich, bereich1, bereich2)
Gruß Werner
Anzeige
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 22:51:37
Niko
Vielen Dank allen euch für mühe und Gedult, ein Unwissenden das Licht im Tunel zu zeigen.
Werde morgen mit Werners lösungsvorschlag weiter machen und bescheid geben wie es läuft.
Danke nochmals allen.
Niko
AW: Range verändern und in verschiedenen Bereichen aufteilen
28.12.2019 10:23:58
Niko
Guten Morgen Welt :-)
anbei die Datei mit den Bereichen, kann es nicht hinkriegen :-( das es sich nur in den bereichen auswirkt wie ich es mir wünsche.
https://www.herber.de/bbs/user/133999.xlsm
Möchte das Range("A12:BA21","A26:BA35","A40:BA49”,"A54:BA63","A68:BA77","A82:BA91","A96:BA105","A110:BA119","A124:BA133","A138:BA147","A152:BA161","A166:BA175","A180:BA189","A194:BA203","A208:BA217","A222:BA231","A236:BA245","A250:BA259","A264:BA273","A278:BA287","A292:BA301","A306:BA315","A320:BA329","A334:BA343","A348:BA357","A362:BA371","A376:BA385","A390:BA399","A404:BA413","A418:BA427","A432:BA441") sich so aufteilt.
Jede Hilfe Wilkommen :-)
Danke,
Niko
Anzeige
AW: Range verändern und in verschiedenen Bereichen aufteilen
28.12.2019 11:10:30
Werner
Hallo Niko,
so schwer?
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim bereich As Range, bereich1 As Range, bereich2 As Range, gesamt As Range
Set bereich = Range("A12:BA21,A26:BA35,A40:BA49,A54:BA63,A68:BA77,A82:BA91," _
& "A96:BA105,A110:BA119,A124:BA133,A138:BA147,A152:BA161")
Set bereich1 = Range("A166:BA175, A180:BA189, A194:BA203, A208:BA217, A222:BA231," _
& "A236:BA245,A250:BA259, A264:BA273, A278:BA287,A292:BA301")
Set bereich2 = Range("A306:BA315, A320:BA329, A334:BA343, A348:BA357, A362:BA371," _
& "A376:BA385,A390:BA399, A404:BA413, A418:BA427, A432:BA441")
Set gesamt = Union(bereich, bereich1, bereich2)
Unprotect "s0nne"
With gesamt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.PatternTintAndShade = 1
End With
If Not Intersect(Target, gesamt) Is Nothing Then
With Range(Cells(Target.Row, 1), Cells(Target.Row, 53)).Interior
.Pattern = xlGray25
.PatternThemeColor = xlThemeColorAccent2
.PatternTintAndShade = 0.399945066682943
End With
Application.EnableEvents = False
Target.Activate
Application.EnableEvents = True
End If
Protect "s0nne"
Set bereich = Nothing: Set bereich1 = Nothing: Set bereich2 = Nothing: Set gesamt = Nothing
End Sub
Gruß Werner
Anzeige
AW: Range verändern und in verschiedenen Bereichen aufteilen
28.12.2019 13:42:19
Niko
Hallo Werner ...vielen, Vielen Dank...habe es vorher versucht ohne erfolg...weil ich am Ende Set bereich = Nothing: nicht im VBA Code hatte :-(
Anyway, echt Super von euch, mit mir zu befassen bis ich es endlich kappiert habe...vielen,vielen Dank :-)
Danke allen die an meiner Lektion mitgewirkt haben :-)...denn Wissen zu haben ist das eine, Wissen weiter zu geben ist das andere...jedes eine Kunst für sich.
May each day of the New Year
Bring happiness, good cheer
And sweet surprises…
To you and all your dear ones!
Happy New Year!
Thx again
Niko
Gerne u. Danke für die Rückmeldung aber..
28.12.2019 14:05:17
Werner
Hallo Niko,
...mit dem Set bereich = Nothing am Ende des Codes hatte das sicher nichts zu tun, da stimmte dann was anderes nicht.
Kanns ja mal mit meinem Code testen indem du die letzte Codezeile mit dem Set ...= Nothing auskommentierst.
Gruß Werner
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 22:46:51
Niko
anbei das Bild der Fehler Meldung
Userbild
AW: Range verändern und in verschiedenen Bereichen aufteilen
27.12.2019 22:36:03
Niko
Mit Nepumuks VBA Hilfe geht es auch net...wo mache ich den Fehler?
Wer Helfen kann, der Rette mich...hat dafür das ganze Jahr den besten Leumund von mir :-) :-)
Danke im Voraus.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Unprotect "s0nne"
With Range("A12:BA21", "A26:BA35", "A40:BA49", "A54:BA63", "A68:BA77", "A82:BA91", "A96: _
BA105", "A110:BA119", "A124:BA133", "A138:BA147", "A152:BA161", "A166:BA175", "A180:BA189", "A194:BA203", "A208:BA217", "A222:BA231", "A236:BA245", "A250:BA259", "A264:BA273", "A278:BA287", "A292:BA301", "A306:BA315", "A320:BA329", "A334:BA343", "A348:BA357", "A362:BA371", "A376:BA385", "A390:BA399", "A404:BA413", "A418:BA427", "A432:BA441").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.PatternTintAndShade = 1
End With
If Not Intersect(Target, Range("A12:BA21", "A26:BA35", "A40:BA49", "A54:BA63", "A68:BA77", " _
A82:BA91", "A96:BA105", "A110:BA119", "A124:BA133", "A138:BA147", "A152:BA161", "A166:BA175", "A180:BA189", "A194:BA203", "A208:BA217", "A222:BA231", "A236:BA245", "A250:BA259", "A264:BA273", "A278:BA287", "A292:BA301", "A306:BA315", "A320:BA329", "A334:BA343", "A348:BA357", "A362:BA371", "A376:BA385", "A390:BA399", "A404:BA413", "A418:BA427", "A432:BA441")) Is Nothing Then
With Range(Cells(Target.Row, 1), Cells(Target.Row, 53)).Interior
.Pattern = xlGray25
.PatternThemeColor = xlThemeColorAccent2
.PatternTintAndShade = 0.399945066682943
End With
Application.EnableEvents = False
Target.Activate
Application.EnableEvents = True
End If
Protect "s0nne"
End Sub

AW: 30 Range / 256 ? Zeichen Limits
28.12.2019 12:02:05
GerdL

Sub Parzellen()
Dim Zeilen As Range
Dim Spalten As Range
Dim Bereich As Range
Set Zeilen = Range("12:21, 26:35, 40:49, 54:63, 68:77, 82:91," _
& "96:105, 110:119, 124:133, 138:147, 152:161, 166:175, 180:189," _
& "194:203, 208:217, 222:231, 236:245, 250:259, 264:273, 278:287," _
& "292:301, 306:315, 320:329, 334:343, 348:357, 362:371, 376:385," _
& "390:399, 404:413, 418:427")
Set Zeilen = Union(Zeilen, Range("432:441"))
Set Spalten = Range("A:BA")
Set Bereich = Intersect(Zeilen, Spalten)
End Sub
Hallo Nico,
welches Farbenspiel du genau möchtest, weis ich nicht.
Gruß Gerd

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige