VBA- Einsparungen mit Union( möglich?

[Hans Alborg]

Hallo,

<Excel 2007>

Ich habe sehr viel Code in meiner Mappe wie den:
'--------------------------------------------------------------
Set Kontakte_s = Union(Cells(12, mynr + 7), _
Cells(12, mynr + 12))
Set Kont_Anz(1) = Cells(12, mynr + 7)
Set Kont_Anz(2) = Cells(12, mynr + 12)
' --- ( das geht bis zu 8 Stck.! ) ---
Call Schließer_senkrecht
Call Kontaktnamen_Anzug
' --------------------------------------------------------
' die Unterroutinen dazu:
' --------------------------------------------------------
Sub Schließer_senkrecht()
Kontakte_s.Borders(xlEdgeTop).LineStyle = xlNone
End Sub
' --------------------------------------------------------
Sub Kontaktnamen_Anzug()
For j = 1 To 8
With Kont_Anz(j)
If Kont_Anz(j) Is Nothing Then Exit Sub
.Value = Left(Kont_Anz(j).Value, Len(Kont_Anz(j).Value) - 1)
& "á"
.Characters(Start:=Len(Kont_Anz(j).Value),
Length:=1).Font.Name = "Wingdings"
End With
Set Kont_Anz(j) = Nothing
Next j
End Sub
' --------------------------------------------------------
Das sind in meiner Simulation Schaltkontakte (grafisch mit Rahmenteilen
dargestellt) und deren Bezeichnungen.
Das ist immer so, daß beide Zelladressen gleich sind, wie oben gezeigt.
Es gibt aber viele dieser Vorgänge mit bis zu 8 Zellen irgendwo auf dem
Blatt!

Leider gelingt es mir nicht, das Union -Feld für die Namen zu benutzen, weil
die in jeder Zelle verschieden sein können.
Wie in der 2. Unterroutine zu sehen ist, ändere ich nur das letzte Zeichen
eines verschieden langen Strings (und dessen Font).
Dieses Zeichen ist ein Pfeil nach oben (woanders wird es in einen Pfeil nach
unten geändert).

Gibt es eine Möglichkeit, beide Änderungen doch mit 1x Union(Cells...)
anzusprechen?

TIA,

Hans

[Claus Busch]

Hallo Hans,

Post by Hans Alborg
Gibt es eine Möglichkeit, beide Änderungen doch mit 1x Union(Cells...)
anzusprechen?

probiere mal folgenden Code. Du musst zuerst "Test" laufen lassen, damit
"Kontakte_s" initialisiert ist:

Option Explicit
Public Kontakte_s As Range

Sub Test()
Dim strNr As String
Dim arrNr As Variant, Kont_Anz() As Variant
Dim i As Long, myNr As Long

strNr = "7,12,17,22,27"
arrNr = Split(strNr, ",")
myNr = 5

For i = LBound(arrNr) To UBound(arrNr)
ReDim Preserve Kont_Anz(UBound(arrNr))
Kont_Anz(i) = Cells(12, myNr + arrNr(i))
Next

For i = LBound(arrNr) To UBound(arrNr)
If Kontakte_s Is Nothing Then
Set Kontakte_s = Cells(12, myNr + arrNr(i))
Else
Set Kontakte_s = Union(Kontakte_s, Cells(12, myNr + arrNr(i)))
End If
Next

End Sub

Sub Kontaktnamen_Anzug()
Dim rngC As Range

For Each rngC In Kontakte_s
If rngC Is Nothing Then Exit Sub
With rngC
.Value = Left(rngC, Len(rngC.Text) - 1) & "á"
.Characters(Start:=Len(rngC), _
Length:=1).Font.Name = "Wingdings"
End With
Next
End Sub


Mit freundlichen Grüßen
Claus

[Claus Busch]

Hallo Hans,

Post by Claus Busch
probiere mal folgenden Code. Du musst zuerst "Test" laufen lassen, damit

oder zuerst den Range zusammenstellen und diesen dann auslesen:

Sub Test2()
Dim strNr As String
Dim arrNr As Variant, Kont_Anz() As Variant
Dim i As Long, myNr As Long
Dim rngC As Range

strNr = "7,12,17,22,27"
arrNr = Split(strNr, ",")
myNr = 5

For i = LBound(arrNr) To UBound(arrNr)
If Kontakte_s Is Nothing Then
Set Kontakte_s = Cells(12, myNr + arrNr(i))
Else
Set Kontakte_s = Union(Kontakte_s, Cells(12, myNr + arrNr(i)))
End If
Next

i = 0
For Each rngC In Kontakte_s
ReDim Preserve Kont_Anz(Kontakte_s.Cells.Count - 1)
Kont_Anz(i) = rngC.Value
i = i + 1
Next

End Sub


Mit freundlichen Grüßen
Claus

[Claus Busch]

Hallo nochmals,

Post by Claus Busch
strNr = "7,12,17,22,27"
arrNr = Split(strNr, ",")

strNr wird nicht gebraucht. Das habe ich mir so angewöhnt, weil ich
meistens Strings in einem Array habe und im Code nicht so viele
Anführungszeichen schreiben möchte. Zahlen kannst du direkt übergeben
ohne Anführungszeichen:

arrNr = Array(7, 12, 17, 22, 27)


Mit freundlichen Grüßen
Claus

[Hans Alborg]

Hi Claus,

"Claus Busch" schrieb...
arrNr = Array(7, 12, 17, 22, 27)

Hm...

Dein Code ist erstmal etwas schwierig für mich, vor allem wenn ich diese
Arrays zusammenstellen soll.
In meinem Beispiel oben ist die Zeile "12" nur zufällig zweimal dieselbe,
sorry. Sie kann von "8"..."300" reichen.

Mit den verschiedenen Zeilen _und_ Spalten ergibt sich dann ein
mehrdimensionales Array?
Oder zwei? Dann müßte Zeile und Spalte immer an derselben Kommastelle
stehen. Da ist ein Fehler schwer aufzuspüren.

Ich hatte eigentlich gehofft, die "Union("- Daten behalten zu können und die
Variablen "Kont_Anz()" zu sparen.

Außerdem fehlt die Rahmenänderung:

Sub Schließer_senkrecht()
Kontakte_s.Borders(xlEdgeTop).LineStyle = xlNone
End Sub

Naja, mit dem Varablenfeld "Kont_Anz()" läßt sich der Rahmen bestimmt auch
ändern, so rum hatte ich nicht gedacht.

"Union(xy" ist halt schööön übersichtlich, ich muß noch tausende Werte
eingeben :-(

Uaaa! Ich werde den Code wohl erst morgen richtig testen können...

Hans

[Claus Busch]

Hallo Hans,

Post by Claus Busch
arrNr = Array(7, 12, 17, 22, 27)

das sind die Zahlen, aus denen du die Spaltennummer generierst.

Post by Claus Busch
Dein Code ist erstmal etwas schwierig für mich, vor allem wenn ich diese
Arrays zusammenstellen soll.
In meinem Beispiel oben ist die Zeile "12" nur zufällig zweimal dieselbe,
sorry. Sie kann von "8"..."300" reichen.

Dann musst du den Union-Bereich halt einzeln befüllen anstatt über eine
Schleife.

Post by Claus Busch
Ich hatte eigentlich gehofft, die "Union("- Daten behalten zu können und die
Variablen "Kont_Anz()" zu sparen.

Ich wußte ja nicht, was du mit "Kont_Anz" vor hast. Aber das brauchst du
eigentlich nicht, wenn "Kontakte_s" außerhalb des Moduls Public
deklarierst. Dann bleibt dir der Bereich erhalten.
Nur zum Ändern und zum Formatieren des letzten Zeichens musst du durch
eine Schleife, denn das geht nicht mit dem kompletten Bereich.

Post by Claus Busch
Sub Schließer_senkrecht()
Kontakte_s.Borders(xlEdgeTop).LineStyle = xlNone
End Sub

Das aber schon.


Mit freundlichen Grüßen
Claus

[Hans Alborg]

Hi Claus,

"Claus Busch" schrieb...

Post by Claus Busch

Post by Hans Alborg
In meinem Beispiel oben ist die Zeile "12" nur zufällig zweimal dieselbe,

Dann musst du den Union-Bereich halt einzeln befüllen anstatt über eine
Schleife.

Den stelle ich sowieso per Hand zusammen, für jeden der 'zig Fälle extra.
Das kann keine Automatik leisten.

Post by Claus Busch

Post by Hans Alborg
Ich hatte eigentlich gehofft, die "Union("- Daten behalten zu können und
die Variablen "Kont_Anz()" zu sparen.

Ich wußte ja nicht, was du mit "Kont_Anz" vor hast.

Naja, die sind identisch mit den Zellen des Union- Bereichs. Da läßt sich
wohl was sparen, dachte ich.

Post by Claus Busch
Nur zum Ändern und zum Formatieren des letzten Zeichens musst du durch
eine Schleife, denn das geht nicht mit dem kompletten Bereich.

Bernhard hat eine gute Idee gehabt, nämlich den kompletten Text zu ändern
statt des letzten Zeichens.
Ich hab so einen Fontmanager, der hat mir die Pfeile von Arial nicht
angezeigt, der Schlingel...

Ich glaube, darauf wird's hinauslaufen!

Vielen Dank,

Hans

[Bernhard Sander]

Hallo Hans,

Post by Hans Alborg
Das sind in meiner Simulation Schaltkontakte (grafisch mit Rahmenteilen
dargestellt) und deren Bezeichnungen.
Das ist immer so, daß beide Zelladressen gleich sind, wie oben gezeigt.
Es gibt aber viele dieser Vorgänge mit bis zu 8 Zellen irgendwo auf dem
Blatt!
Leider gelingt es mir nicht, das Union -Feld für die Namen zu benutzen, weil
die in jeder Zelle verschieden sein können.
Wie in der 2. Unterroutine zu sehen ist, ändere ich nur das letzte Zeichen
eines verschieden langen Strings (und dessen Font).
Dieses Zeichen ist ein Pfeil nach oben (woanders wird es in einen Pfeil nach
unten geändert).
Gibt es eine Möglichkeit, beide Änderungen doch mit 1x Union(Cells...)
anzusprechen?

Wie Claus schon schrieb, kannst Du nicht innerhalb eines Bereiches mit einem Befehl den Text von Zellen zeichenweise verändern.
Du kannst nur allen Zellen des Bereichs (auch mit Union zusammengestellt) den gleiche Text zuweisen.

Wenn es nicht allzu viele verschiedene Texte sind, dann kannst Du bei den betroffenen Zellen den unveränderlichen Text in das Zellenformat auslagern.
Es würde beispielhaft so aussehen:
;;;"Text vorher "@" Text danach"
Also: zuerst 3 Strichpunkte, dann die festen Textteile in Gänsefüßchen eingeschlossen, der Zellinhalt wird durch den Klammeraffen angesprochen.
Nun kannst Du in allen betroffenen Zellen mit dem gleichen variablen Teil auf einen Rutsch Deine Pfeilchen eintragen.

Nun nimmst Du noch einen Unicode-Zeichensatz (sollte m.E. auch in 2007 funktionieren) wie Arial oder Calibri und verwendest die Unicode-Pfeile statt der Symbol-Pfeile.
Pfeil-hoch ist ChrW(8593)
Pfeil-runter ist ChrW(8595)

Gruß
Bernhard Sander

[Hans Alborg]

Hallo Bernhard,

"Bernhard Sander" schrieb...

Post by Bernhard Sander
Wenn es nicht allzu viele verschiedene Texte sind, dann kannst Du bei den
betroffenen Zellen den unveränderlichen Text in das Zellenformat
auslagern.

Es sind bestimmt hunderte, aber das macht nichts. Die Union- Bereiche sind
ja genausoviele. Die Texte sind nur max. 7 Zeichen lang.

Post by Bernhard Sander
Nun nimmst Du noch einen Unicode-Zeichensatz (sollte m.E. auch in 2007
funktionieren) wie Arial oder Calibri und verwendest die Unicode-Pfeile
statt der Symbol-Pfeile.
Pfeil-hoch ist ChrW(8593)
Pfeil-runter ist ChrW(8595)

Ich hab nicht gewußt daß Arial/ Calibri Pfeile hat. Klar läßt sich dann der
ganze Name tauschen.

Jetzt muß ich wohl eine Routine schreiben, die alle Tabellenblätter absucht
und den Font tauscht :-/

Danke für den Tip!
Hans

[Bernhard Sander]

Hallo Hans,

Post by Hans Alborg

Post by Bernhard Sander
Wenn es nicht allzu viele verschiedene Texte sind, dann kannst Du bei den
betroffenen Zellen den unveränderlichen Text in das Zellenformat
auslagern.

Es sind bestimmt hunderte, aber das macht nichts. Die Union- Bereiche sind
ja genausoviele. Die Texte sind nur max. 7 Zeichen lang.

Sind es hunderte Zellen mit ein paar wenigen unterschiedlichen Texten oder sind es hunderte verschiedene Texte?
Du benötigst halt für jeden Text ein eigenes Format. Da ist Excel angeblich auf ca. 200-250 Einträge beschränkt.

Post by Hans Alborg

Post by Bernhard Sander
Nun nimmst Du noch einen Unicode-Zeichensatz (sollte m.E. auch in 2007
funktionieren) wie Arial oder Calibri und verwendest die Unicode-Pfeile
statt der Symbol-Pfeile.
Pfeil-hoch ist ChrW(8593)
Pfeil-runter ist ChrW(8595)

Ich hab nicht gewußt daß Arial/ Calibri Pfeile hat. Klar läßt sich dann der
ganze Name tauschen.
Jetzt muß ich wohl eine Routine schreiben, die alle Tabellenblätter absucht
und den Font tauscht :-/

Hm, wenn sowieso überall der gleiche Font verwendet werden soll, dann geh auf's Tabellenblatt, drücke Ctrl-A und setze den gewünschten Font.
Einzeln eingesetzte Symbole werden dabei umformatiert.

Die Zeichen selbst lassen sich ja über "Suchen und Ersetzen" austauschen. Am einfachsten fügt man die beiden auszutauschenden Zeichen in 2 Zellen ein und kopiert sie daraus in den "Ersetzen"-Dialog.

Bei dem Format-Verfahren musst Du aber sowieso in allen betroffenen Zellen den Text löschen, den Pfeil eintragen und das Zellformat anwenden.

Gruß
Bernhard Sander

[Claus Busch]

Hallo Hans, hallo Bernhard,

Post by Bernhard Sander

Post by Hans Alborg
Es sind bestimmt hunderte, aber das macht nichts. Die Union- Bereiche sind
ja genausoviele. Die Texte sind nur max. 7 Zeichen lang.

Sind es hunderte Zellen mit ein paar wenigen unterschiedlichen Texten oder sind es hunderte verschiedene Texte?
Du benötigst halt für jeden Text ein eigenes Format. Da ist Excel angeblich auf ca. 200-250 Einträge beschränkt.

du brauchst doch nur das letzte Zeichen auszutauschen, der Text wird
doch nicht verändert wie ich dich verstanden habe.
Das ginge doch so mit deinem Bereich für Pfeil nach oben:

Dim rngC As Range
For Each rngC In Kontakte_s
With rngC
.Value = Left(rngC, Len(rngC) - 1) & _
Replace(.Value, Right(.Value, Len(.Value)), ChrW(8593))
End With
Next


Mit freundlichen Grüßen
Claus

[Bernhard Sander]

Hallo Claus,

Post by Claus Busch
du brauchst doch nur das letzte Zeichen auszutauschen, der Text wird
doch nicht verändert wie ich dich verstanden habe.
Dim rngC As Range
For Each rngC In Kontakte_s
With rngC
.Value = Left(rngC, Len(rngC) - 1) & _
Replace(.Value, Right(.Value, Len(.Value)), ChrW(8593))
End With
Next

Hans wollte doch gerne statt der Schleife so einen Einzeiler:

Kontakte_s.value = chrW(8593)

Und der ist mit dem "Text-Format" möglich.

Gruß
Bernhard Sander

[Hans Alborg]

"Hans Alborg" schrieb...

Post by Hans Alborg
Danke für den Tip!

So wirds wohl aussehen:
' --------------------------------------------------------
Sub Schließer()
If Not Kontakte_s Is Nothing Then
With Kontakte_s
.Borders(xlEdgeTop). _
LineStyle = xlNone
.Value = Kt_Name & " " _
& ChrW(8593)
End With
End If
If Not Kontakte_w Is Nothing Then
With Kontakte_w
.Borders(xlEdgeLeft). _
LineStyle = xlNone
.Value = Kt_Name & " " _
& ChrW(8593)
End With
End If
Set Kontakte_w = Nothing
Set Kontakte_s = Nothing
End Sub

' --------------------------------------
Damit kann ich die Union(Ranges) behalten, spare die Zuweisungen zu den
Namen und habe auch gleich die Routinen für senkrechte ( Kontakte_s) und
waagrechte ( Kontakte_w) Symbole vereint. Die Namen stehen in der Variablen
Kt_Name.

Jetzt gibt's erstmal viel Arbeit :-)
Hans