Makro anpassen oder 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 Ganze 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 kann aber kein VBA.
Wenn Ihr möchtet, lade ich das Makro und eine meiner Tabellen hoch. werde es zumindest versuchen, annsonsten geht das natürlich auch über Mail.

Kann mir jemand von Euch helfen?

Viele Grüße

Rolf

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

Ich versuch's mal ungetestet ..., vielleicht hängt sich noch einer mit ran ;-)
BTW teste das mal in einer Kopie deiner Datei ...nur ein Schuss ins Blaue

lg Nancy
--


Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim iCol As Integer
dim iRow as integer
'bezieht sich nur auf Zeilen 1+2, deswegen auskommentiert
'If Target.Row > 2 Then Exit Sub
'schade, das kennen wir nicht ;-)
Set wks = Worksheets("Data")
'die Spalte der Zielzelle (zuletzt aktiv/geänderte)
iCol = Target.Column
iRow = target.row 'dito, aber Zeile
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
If Not IsError(Application.Match(Cells(iRow, iCol).Value, wks.Columns(1), 0)) And _
Not IsError(Application.Match(Cells(iRow+1, iCol).Value, wks.Columns(3), 0)) Then
Cells(iRow, iCol).NumberFormat = """(""@"")"""
End If
If Not IsError(Application.Match(Cells(iRow, iCol).Value, wks.Columns(1), 0)) And _
IsError(Application.Match(Cells(iRow+1, iCol).Value, wks.Columns(3), 0)) Then
Cells(iRow, iCol).NumberFormat = "@"
End If
ERRORHANDLER:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim r as Long Dim wks As Worksheet Dim iCol As Integer r = Target.Row 'wenn Row durch 3 teilbar exit sub If Int(r / 3) <> r / 3 Then Exit Sub 'Naja, könnt man auch weglassen 'wenn r durch zwei teilbar, um eins verringern If Int(r / 2) = r / 2 Then r = r - 1 Set wks = Worksheets("Data") iCol = Target.Column Application.EnableEvents = False On Error GoTo ERRORHANDLER If Not IsError(Application.Match(Cells(r, iCol).Value, wks.Columns(r), 0)) Then If Not IsError(Application.Match(Cells(r + 1, iCol).Value, wks.Columns(r + 2), 0)) Then Cells(r, iCol).NumberFormat = """(""@"")""" Else Cells(r, iCol).NumberFormat = "@" End If End If ERRORHANDLER: Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread