Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender Navigationstipps
Inhaltsverzeichnis

Makro umstellen

Makro umstellen
07.12.2003 17:40:31
Rolf 2
Hallo Fachleute,

ich brauche Eure Hilfe.
Ich möchte in einer Tabelle mit mehreren Tabellenblättern erreichen, dass bei der Eingabe von bestimmten Werten in Zeile 2 die zuvor eingetragenen Werte in Zeile 1 in Klammer gesetzt werden. Gleichzeitig soll bei Eingabe eines Wertes in Zeile 1, eine Angabe in Zeile drei gemacht werden.
Beispiel:

Zeile 1 S
Zeile 2
Zeile 3 7


Zeile 1 (S)
Zeile 2 K
Zeile 3 7

Die Daten in Zeile 3 und die Kriterien, durch welche Info in Zeile 2 der Wert in Zeile 1 in Klammer gesetzt werden soll, kommen aus einer Data-Tabelle.

Um dies zu ermöglichen hat mir ein Fachmann bereits ein Makro programmiert. Dieses funktionierte auch wunderbar, aber nur wenn man das Ganz in Zeile 1 bis 3 benutzt.
In meinen Tabellenblättern soll das aber über mehrere Zeilen gelten, wobei immer drei zusammenhängend sind. Also

Zeile 1
Zeile 2
Zeile 3

Dann
Zeile 4
Zeile 5
Zeile 6

Etc.

Man müsste also wahrscheinlich nur das Makro in dessen Erfassungsbereich umstellen. So hoffe ich zumindest.
Ich schreibe das Makro hier mit ein. Wenn jemand möchte maile ich die excel Datei auch gerne zu, das würde bestimmt helfen. Ich bekomme sie leider hier nicht auf den Server hochgeladen. Warum das nicht geht weiß ich leider nicht.

Kann mir jemand von Euch helfen?

Viele Grüße

Rolf

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim iCol As Integer
If Target.Row > 2 Then Exit Sub
Set wks = Worksheets("Data")
iCol = Target.Column
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
If Not IsError(Application.Match(Cells(1, iCol).Value, wks.Columns(1), 0)) And _
Not IsError(Application.Match(Cells(2, iCol).Value, wks.Columns(3), 0)) Then
Cells(1, iCol).NumberFormat = """(""@"")"""
End If
If Not IsError(Application.Match(Cells(1, iCol).Value, wks.Columns(1), 0)) And _
IsError(Application.Match(Cells(2, iCol).Value, wks.Columns(3), 0)) Then
Cells(1, iCol).NumberFormat = "@"
End If
ERRORHANDLER:
Application.EnableEvents = True
End Sub

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro umstellen
07.12.2003 18:11:19
Günther Abel
Hallo Rolf,

If Target.Row > 2 Then Exit Sub
bewirkt, dass bei Eingaben ab Zeile 3 das Makro abgebrochen wird.
Ich habe diese Zeile hier durch ein ' deaktiviert.
Es wird jetzt also bei Eingaben in der gesamten Tabelle aktiviert.
Solltest du aber in den Tabellen noch Eingaben ohne
diese Funktion machen wollen, so müssen die entsprechenden
Bereiche wieder ausgeklammert werden.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim iCol As Integer
'  If Target.Row > 2 Then Exit Sub
Set wks = Worksheets("Data")
iCol = Target.Column
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
If Not IsError(Application.Match(Cells(1, iCol).Value, wks.Columns(1), 0)) And _
Not IsError(Application.Match(Cells(2, iCol).Value, wks.Columns(3), 0)) Then
Cells(1, iCol).NumberFormat = """(""@"")"""
End If
If Not IsError(Application.Match(Cells(1, iCol).Value, wks.Columns(1), 0)) And _
IsError(Application.Match(Cells(2, iCol).Value, wks.Columns(3), 0)) Then
Cells(1, iCol).NumberFormat = "@"
End If
ERRORHANDLER:
Application.EnableEvents = True
End Sub


Gruss
Günther
Anzeige
AW: Makro umstellen
07.12.2003 20:07:39
Rolf 2
Hallo Günther,

Danke für deine Info. Leider hat das nicht funktioniert. Auch wenn ich Dein Makro teste, wirkt es nicht über Zeile 2 hinaus. Wenn ich dann Dein Hochkomme entfere und bei z.B: "If Target.Row > 9 Then Exit Sub" eingebe, wird das Makro trotzdem nicht auf Zeile
4 und 5 etc. angewandt.

Peter hatte eine andere Idee, die funktioniert. Dafür habeich nun aber ein anderes Problem. Meine Werte in der ersten Zeile, wie z.B. S und F etc. werden nun in Klammern gesetzt. Allerdings nur in der Anzeige. Im Wert wird dies wohl nicht berücksichtigt. Ich habe nämlich in den Spalten einen Summenzähler über eine Funktion eingebaut, der die Anzahl der S und F etc. zählen soll. Wenn diese Werte in Klammer gesetzt werden, werden diese normalerweise nicht mehr gezählt, was ich auch gerne so möchte.
Mit dem Makro werden diese aber trotzdem gezählt. Wenn ich in die Zell egehe, in der z.B: (F) steht, sehe ich in der Bearbeitungsleiste nur ein F.

Weißt Du darauf eine Lösung?

Rolf 2
Anzeige
Heiliger Bimbam,
07.12.2003 21:19:17
Günther Abel
da war ich wohl zu oberflächlich...
es wird ja nochmals die Zeilenbeschränkung eingesetzt.

Da hat Peter besser aufgepasst -
und anscheinend habt Ihr die Formate jetzt auch im Griff.
Das mit den Formaten finde ich ganz nebenbei eine sehr interessante Lösung.

Viel Spass

Günther
AW: Heiliger Bimbam,
07.12.2003 23:37:07
Rolf 2
Hallo Günther,

ja Peter hat das gut hinbekommen. Vielen Dank auch an Dich, daß Du es versucht hast.

Viele Grüße

Rolf 2
AW: Makro umstellen
07.12.2003 18:46:15
PeterW
Hallo Rolf,

ich find in deinem Code die Stelle nicht, wo in Zeile 3 etwas eingetragen wird. Die Umstellung auf jeweils 3 Zeilen (1-3, 4-6,...) könnte ausgehend vom geposteten Code so aussehen:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim iCol As Integer
Dim iHilf As Long
If Target.Row Mod 3 = 0 Then Exit Sub
iHilf = Int((Target.Row + 2) / 3) - 1
Set wks = Worksheets("Data")
iCol = Target.Column
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
If Not IsError(Application.Match(Cells(iHilf * 3 + 1, iCol).Value, wks.Columns(1), 0)) And _
Not IsError(Application.Match(Cells(iHilf * 3 + 2, iCol).Value, wks.Columns(3), 0)) Then
Cells(iHilf * 3 + 1, iCol).NumberFormat = """(""@"")"""
End If
If Not IsError(Application.Match(Cells(iHilf * 3 + 1, iCol).Value, wks.Columns(1), 0)) And _
IsError(Application.Match(Cells(iHilf * 3 + 2, iCol).Value, wks.Columns(3), 0)) Then
Cells(iHilf * 3 + 1, iCol).NumberFormat = "@"
End If
ERRORHANDLER:
Application.EnableEvents = True
End Sub

Gruß
Peter
Anzeige
AW: Makro umstellen
07.12.2003 20:11:38
Rolf 2
Hallo Peter,

Du bist ein Genie!
Dein Makro funktioniert nun über die ganze Tabelle.
Erst einmal vielen Dank dafür.

Dafür habe ich nun aber ein anderes Problem, welches ich mir der Klammerlösung dachte lösen zu können. Meine Werte in der ersten Zeile, wie z.B. S und F etc. werden nun ja in Klammern gesetzt. Allerdings nur in der Anzeige. Im Wert wird dies wohl nicht berücksichtigt. Ich habe nämlich in den Spalten einen Summenzähler über eine Funktion eingebaut, der die Anzahl der S und F etc. zählen soll. Wenn diese Werte in Klammer gesetzt werden, werden diese normalerweise nicht mehr gezählt, was ich auch gerne so möchte.
Mit dem Makro werden diese aber trotzdem gezählt. Wenn ich in die Zelle gehe, in der z.B: (F) steht, sehe ich in der Bearbeitungsleiste nur ein F. Somit wird es mit der Funktion =SUMME(WENN trotzdem gezählt, obwohl die Klammer gebau dies verhindern sollte

Weißt Du darauf eine Lösung?

Rolf 2
Anzeige
AW: Makro umstellen
07.12.2003 20:20:15
PeterW
Hallo Rolf,

das neue Problem ist klar. Es werden im Code nur die Zellformate verändert, nicht die Zellwerte.
Ersetze die Zeile
Cells(iHilf * 3 + 1, iCol).NumberFormat = """(""@"")"""
durch
Cells(iHilf * 3 + 1, iCol)= "(" & Cells(iHilf * 3 + 1, iCol) & ")"

Gruß
Peter
AW: Makro umstellen
07.12.2003 21:01:13
Rolf 2
Hallo Peter,

Huhu. Nun werde die Angaben tatsächlich in Klammer gesetzt. Du bist wirklich gut!
Allerdings werden die Werte, beim Löschen des K nicht wieder ohne Klammer dargestellt, wenn man dieses aus versehen in eine falsche Zelle gesetzt hat.
Ist das möglich, oder geht dies mit diesem Makro so nicht?
Anders gefargt, kann man den Eintrag

Cells(iHilf * 3 + 1, iCol).NumberFormat = """(""@"")"""
und
Cells(iHilf * 3 + 1, iCol)= "(" & Cells(iHilf * 3 + 1, iCol) & ")"

irgendwie kombinieren?

Rolf 2
Anzeige
AW: Makro umstellen
07.12.2003 21:17:57
PeterW
Hallo Rolf,

du hattest im ursprünglichen Posting geschrieben, dass der Code funktioniert. Inzwischen kann ich das nicht mehr recht glauben. :-)
Ich bleib mal im ursprünglichen Code und biete folgende Änderung an:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim iCol As Integer
Dim iHilf As Long
If Target.Row Mod 3 = 0 Then Exit Sub
iHilf = Int((Target.Row + 2) / 3) - 1
Set wks = Worksheets("Data")
iCol = Target.Column
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
If Not IsError(Application.Match(Cells(iHilf * 3 + 1, iCol).Value, wks.Columns(1), 0)) And _
Not IsError(Application.Match(Cells(iHilf * 3 + 2, iCol).Value, wks.Columns(3), 0)) Then
Cells(iHilf * 3 + 1, iCol) = ")" & Cells(iHilf * 3 + 1, iCol) & ")"
End If
If Not IsError(Application.Match(Cells(iHilf * 3 + 1, iCol).Value, wks.Columns(1), 0)) And _
IsError(Application.Match(Cells(iHilf * 3 + 2, iCol).Value, wks.Columns(3), 0)) Then
Cells(iHilf * 3 + 1, iCol) = Mid(Cells(iHilf * 3 + 1, iCol), 2, 1)
End If
ERRORHANDLER:
Application.EnableEvents = True
End Sub

Gruß
Peter
Anzeige
AW: Makro umstellen
07.12.2003 21:51:37
Rolf 2
Hallo Peter,

doch Dein Tipp mit der Umstellung der Zeile
Cells(iHilf * 3 + 1, iCol).NumberFormat = """(""@"")"""
und
Cells(iHilf * 3 + 1, iCol)= "(" & Cells(iHilf * 3 + 1, iCol) & ")"

Hat wunderbar funktioniert. Wieso zweifelst du daran? Du hast das gut gemacht.

Einzig wenn man das K wieder entfernt hatte, was ja für die Klammersetzung ursächlich ist, wurde die Klammer nicht mehr entfernt, was zuvor möglich war. Dies aber wohl nur, weil es zuvor nur in der Anzeige angegeben wurde und nun im Ergebnis dargestellt wird.

Du hast das als Bester gelöst. Dafür bin ich auch sehr dankbar.
Es war nur die Frage, ob es auch möglich wäre, die Klammer wieder zu entfernen, wenn man z.B. den Wert K wieder entfernt.
wenn das nicht möglich ist, müssen die Kollegen eben den in Klammer gesetzten Buchstaben wieder eingaben und gut ist es.

Dein Makro von eben habe ich trotdzem einmal versucht. Es zerschlägt alles. Zum einen wird nicht () angezeigt sondern )) und dann kan ich keinerlei S der F mehr eingeban. Alles wird sofort wieder gelöscht und zwar mit oder ohne Klammer.

Ich bin wirklich sehr froh, daß Du mir schon soweit geholfen hast.

Vielen, vielen Dank dafür

viele Grüße

Rolf 2
Anzeige
AW: Makro umstellen
07.12.2003 22:14:01
PeterW
Hallo Rolf,

wollte dir nichts zerschießen - und hab auch an nichts gezweifelt außer an den Tatsache, dass dem ursprünglichen Programmierer die Aufgabenstellung komplett bekannt war. :-)
Wenn der Code vor der letzten Änderung fehlerfrei lief könnte dir diese Version das Problem mit dem Löschen der Klammern lösen:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim iCol As Integer
Dim iHilf As Integer
If Target.Row Mod 3 = 0 Then Exit Sub
iHilf = Int((Target.Row + 2) / 3) - 1
Set wks = Worksheets("Data")
iCol = Target.Column
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
If Not IsError(Application.Match(Cells(iHilf * 3 + 1, iCol).Value, wks.Columns(1), 0)) And _
Not IsError(Application.Match(Cells(iHilf * 3 + 2, iCol).Value, wks.Columns(3), 0)) Then
Cells(iHilf * 3 + 1, iCol) = ")" & Cells(iHilf * 3 + 1, iCol) & ")"
End If
If Not IsError(Application.Match(Cells(iHilf * 3 + 1, iCol).Value, wks.Columns(1), 0)) And _
IsError(Application.Match(Cells(iHilf * 3 + 2, iCol).Value, wks.Columns(3), 0)) Then
Cells(iHilf * 3 + 1, iCol).NumberFormat = "@"
End If
If Cells(iHilf * 3 + 2, iCol) = "" And Left(Cells(iHilf * 3 + 1, iCol), 1) = "(" Then
Cells(iHilf * 3 + 1, iCol) = Mid(Cells(iHilf * 3 + 1, iCol), 2, 1)
End If
ERRORHANDLER:
Application.EnableEvents = True
End Sub

Sofern damit das Problem nicht befriedigend aus der Welt ist wäre eine Beispielmappe hilfreich.

Gruß
Peter
Anzeige
AW: Makro umstellen
07.12.2003 22:40:06
Rolf 2
Hallo Peter,

Du hast vollkommen recht. Der Ursprüngliche Programmierer wusste nicht die ganze Geschichte. Das lag aber daran, daß er sich nach den ersten Versuchen nicht mehr gemeldet hatte. Deswegen schwamm ich ja mit der halbfertigen Sache.
Weiterhin wurde diese Dilemma durch meine Unkenntnis des Programmierens verursacht.

Umso mehr muss ich mich für Deine ganz tolle Lösung sehr bedanken.
Du hast mir auch nichts zerschlagen. Das war wohl wieder eine falsche Bezeichnung von mir. Es ist nichst kaput gegangen. Die Funktionen wurden nur nicht mehr angezeigt. Aber das ist nicht schlimm. Habe ja alles nur in einer Kopie angewandt.

Ich habe gerade dein letztes Makro ausprobiert.
Darin habe ich in der Zeile

Cells(iHilf * 3 + 1, iCol) = ")" & Cells(iHilf * 3 + 1, iCol) & ")"

das ")" in ein "(" geändert.

Seitdem funktioniert es ganz wunderbar. Ich hoffe das ist in Ordnung so?

Wie kann ich mich dankbar erweisen?

Gebe mir bitte Bescheid, denn Du hast mir wirklich sehr geholfen.

Und noch einmal vielen Dank

Viele Grüße

Rolf 2
Anzeige
erledigt (m.T.)
07.12.2003 22:56:06
PeterW
Hallo Rolf,

die Rückmeldung reicht als Dank. :-)

Die von dir vorgenomme Korrektur war mehr als berechtigt - ein Flüchtigkeitsfehler vor mir. :-(
Der vorletzte Versuch sollte mit dieser Änderung auch funktionieren!

Gruß
Peter
PS: für den höchst unwahrscheinlichen Fall, dass du mit dieser Lösung Euro-Millionär wirst melde dich nochmal mit deiner Email-Adresse: ich schick dir dann meine Bankverbindung wegen der Anteile. ;-)
AW: erledigt (m.T.)
07.12.2003 23:33:39
Rolf 2
Hallo Peter,

mensch das gibt es ja fast nicht. Du möchtest wirklcih nichts für Deine Zeit haben?
Ich würde mich gerne erkenntlich zeigen. Du hast doch auch Zeit investiert.
Wenn Du dies hier nicht machen kannst, melde Dich doch bitte via Mail. Meine lautet RolfWagner@T-Online.de

Nochmals vielen Dank an Dich.
Sollte ich Millionär werden ;-), melde ich mich gerne.

Viele Grüße

Rolf 2
AW: erledigt (m.T.)
08.12.2003 00:05:58
PeterW
Hallo Rolf,

alle Antworter sind freiwillig aus bestimmt vielen verschiedenen Gründen hier tätig. :-)
Schau mal in dein Postfach.

Gruß
Peter

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige