Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro-Erweiterung

Forumthread: Makro-Erweiterung

Makro-Erweiterung
28.09.2013 14:48:48
Burghard
Hallo,
ich würde gerne das untere Makro (funktioniert) erweitern.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varRow, rngBereich As Range
Set rngBereich = Intersect(Range("C2:C200"), Target)
If rngBereich Is Nothing Then Exit Sub
Application.EnableEvents = False
With Range("G2:G30")
For Each rngBereich In rngBereich.Cells
varRow = Application.Match(rngBereich.Value, .Columns(2), 0)
If IsNumeric(varRow) Then
rngBereich.Value = .Columns(1).Cells(varRow, 1).Value
Else
rngBereich.Value = Empty
End If
Next rngBereich
End With
Application.EnableEvents = True
End Sub
Aktuell ist: Wenn ich in der Spalte C eine Zahl eintrage, dann wird ein Wert (Text) aus dem Bereich G2 bis G30 anstelle der Zahl in die Zelle in Spalte C eingetragen (= Umwandlung).
Die Erweiterung soll können: Wenn ich in Spalte C eine Zahl eintrage, dann soll
a) die bisherige Umwandlung weiterhin bestehen plus
b) in der Spalte D der Nachbarwert von Spalte C, bzw. der Nachbarwert von G2 bis G30 (hier J2 bis J30) eingetragen werden
c) in der Spalte F (neben der Zelle von Spalte C) bzw. der Nachbarwert von G2 bis G30 (hier I2 bis I30) eingetragen werden
In etwa so:
...
rngBereich.Value = .Columns(1).Cells(varRow, 1).Value
rngBereich.Offset(0, 1) = .Columns(4).Cells(varRow, 4).Value
rngBereich.Offset(0, 3) = .Columns(3).Cells(varRow, 3).Value
...
Diese VBA-Formulierungen sind aber so falsch.
Schönen Gruß
Burghard

Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro-Erweiterung
28.09.2013 19:49:52
fcs
Hallo Burghard,
du kannst den Teile ".Columns(x)" in den Zeilen weglassen.
                  rngBereich.Value = .Columns(1).Cells(varRow, 1).Value
rngBereich.Offset(0, 1).Value = .Columns(4).Cells(varRow, 1).Value
rngBereich.Offset(0, 3).Value = .Columns(3).Cells(varRow, 1).Value

würde auch funktionieren. das ist aber eine etwas umständliche Art den Wert auszulesen.
Gruß
Franz
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varRow, rngBereich As Range
Set rngBereich = Intersect(Range("C2:C200"), Target)
If rngBereich Is Nothing Then Exit Sub
Application.EnableEvents = False
With Range("G2:G30")
For Each rngBereich In rngBereich.Cells
varRow = Application.Match(rngBereich.Value, .Columns(2), 0)
If IsNumeric(varRow) Then
rngBereich.Value = .Cells(varRow, 1).Value
rngBereich.Offset(0, 1).Value = .Cells(varRow, 4).Value
rngBereich.Offset(0, 3).Value = .Cells(varRow, 3).Value
Else
rngBereich.ClearContents
rngBereich.Offset(0, 1).ClearContents
rngBereich.Offset(0, 3).ClearContents
End If
Next rngBereich
End With
Application.EnableEvents = True
End Sub

Anzeige
AW: Funktioniert
28.09.2013 20:16:57
Burghard
Hallo Franz,
vielen Dank, das Makro funktioniert jetzt genau wie gewünscht.
Grüße Burghard
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige