Makro umstellen

Bild

Betrifft: Makro umstellen
von: Rolf 2
Geschrieben am: 07.12.2003 17:40:31

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

Bild


Betrifft: AW: Makro umstellen
von: Günther Abel
Geschrieben am: 07.12.2003 18:11:19

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


Bild


Betrifft: AW: Makro umstellen
von: Rolf 2
Geschrieben am: 07.12.2003 20:07:39

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


Bild


Betrifft: Heiliger Bimbam,
von: Günther Abel
Geschrieben am: 07.12.2003 21:19:17

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


Bild


Betrifft: AW: Heiliger Bimbam,
von: Rolf 2
Geschrieben am: 07.12.2003 23:37:07

Hallo Günther,

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

Viele Grüße

Rolf 2


Bild


Betrifft: AW: Makro umstellen
von: PeterW
Geschrieben am: 07.12.2003 18:46:15

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


Bild


Betrifft: AW: Makro umstellen
von: Rolf 2
Geschrieben am: 07.12.2003 20:11:38

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


Bild


Betrifft: AW: Makro umstellen
von: PeterW
Geschrieben am: 07.12.2003 20:20:15

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


Bild


Betrifft: AW: Makro umstellen
von: Rolf 2
Geschrieben am: 07.12.2003 21:01:13

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


Bild


Betrifft: AW: Makro umstellen
von: PeterW
Geschrieben am: 07.12.2003 21:17:57

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


Bild


Betrifft: AW: Makro umstellen
von: Rolf 2
Geschrieben am: 07.12.2003 21:51:37

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


Bild


Betrifft: AW: Makro umstellen
von: PeterW
Geschrieben am: 07.12.2003 22:14:01

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


Bild


Betrifft: AW: Makro umstellen
von: Rolf 2
Geschrieben am: 07.12.2003 22:40:06

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


Bild


Betrifft: erledigt (m.T.)
von: PeterW
Geschrieben am: 07.12.2003 22:56:06

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. ;-)


Bild


Betrifft: AW: erledigt (m.T.)
von: Rolf 2
Geschrieben am: 07.12.2003 23:33:39

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


Bild


Betrifft: AW: erledigt (m.T.)
von: PeterW
Geschrieben am: 08.12.2003 00:05:58

Hallo Rolf,

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

Gruß
Peter


Bild

Beiträge aus den Excel-Beispielen zum Thema " Makro umstellen"