Makro umstellen

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro umstellen

07.12.2003 18:11:19

Günther Abel

AW: Makro umstellen

07.12.2003 20:07:39

Rolf 2

Heiliger Bimbam,

07.12.2003 21:19:17

Günther Abel

AW: Heiliger Bimbam,

07.12.2003 23:37:07

Rolf 2

AW: Makro umstellen

07.12.2003 18:46:15

PeterW

AW: Makro umstellen

07.12.2003 20:11:38

Rolf 2

AW: Makro umstellen

07.12.2003 20:20:15

PeterW

AW: Makro umstellen

07.12.2003 21:01:13

Rolf 2

AW: Makro umstellen

07.12.2003 21:17:57

PeterW

AW: Makro umstellen

07.12.2003 21:51:37

Rolf 2

AW: Makro umstellen

07.12.2003 22:14:01

PeterW

AW: Makro umstellen

07.12.2003 22:40:06

Rolf 2

erledigt (m.T.)

07.12.2003 22:56:06

PeterW

AW: erledigt (m.T.)

07.12.2003 23:33:39

Rolf 2

AW: erledigt (m.T.)

08.12.2003 00:05:58

PeterW

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

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

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

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

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

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread