Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
404to408
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
404to408
404to408
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zellen auslesen und kopieren

Zellen auslesen und kopieren
Torsten
Hallo beisammen,
vor ein paar Tagen habe ich auf eine Anfrage bzgl. obigem Thema von Peter W. folgenden Code genannt bekommen:
If Not Intersect(ActiveCell, Range("G5:G475")) Is Nothing Then
Worksheets("Detail6").Range("E1") = ActiveCell
End If
(... mein eigener Code...)
Wenn der Cursor sich innerhalb des Ranges ("G5:G475") befindet, kann ich über einen cmb_Button den Inhalt der Zelle kopieren und in WS ("Detail6") Range (E1") einfügen. Wird der cmb_Button angeklickt und der Cursor befindet sich außerhalb dieses Ranges, passiert nichts. Das ist gut so.
Jetzt habe ich aber innerhalb des Ranges ("G5:G475") Zellen, deren Inhalt mit Font.ColorIndex = 0 (schwarz) bzw. mit Font.ColorIndex = 5 (blau) gekennzeichnet sind. Der oben beschriebene Kopiervorgang soll nun nur dann stattfinden, wenn Font.ColorIndex = 5 ist, andernfalls soll eine MsgBox erscheinen. Den o.g. Code habe ich daher ergänzt:
If Not Intersect(ActiveCell, Range("G5:G475")) Is Nothing And _
ActiveCell.Font.ColorIndex = 5 Then
Worksheets("Detail6").Range("E1") = ActiveCell
Else
MsgBox "Keine Produkt-Gruppe der Stufe 5 ausgewählt"
Exit Sub
End If
(... mein eigener Code...)
Das läuft auch wie gewünscht durch, bis auf den kleinen Nachteil, daß die Fehlermeldung nunmehr auch dann erscheint, wenn der Cursor sich außerhalb des Ranges ("G5:G475") befindet. Das mag zwar kleinlich sein, aber ich hätte gerne, daß Excel in dem Fall, wie vorher auch, nichts macht.
Wie muß ich den Code abändern, um das so hinzubekommen?
Für Eure Hilfe im voraus besten Dank.
Gruß
Torsten

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Zellen auslesen und kopieren
Matthias
Hallo Torsten,
versuch's mal so: Zwei If-Schleifen verschachteln
If Not Intersect(ActiveCell, Range("G5:G475")) Is Nothing Then
If ActiveCell.Font.ColorIndex = 5 Then
Worksheets("Detail6").Range("E1") = ActiveCell
Else
MsgBox "Keine Produkt-Gruppe der Stufe 5 ausgewählt"
Exit Sub
End If
End If
(... Dein eigener Code...)
Gruß Matthias
AW: Zellen auslesen und kopieren
Torsten
Hallo Matthias,
vielen Dank für Deine Rückmeldung.
Deinen Vorschlag hatte ich auch schon probiert: Es ändert sich ggü. dem aktuellen Code leider nichts, das heißt, daß Excel auch dann die MsgBox bringt, wenn der Cursor sich außerhalb des Ranges ("G5:G475") befindet.
Noch eine andere Idee? Ich leider nicht mehr :-(
Gruß
Torsten
Anzeige
AW: Zellen auslesen und kopieren
Matthias
Hallo Torsten,
ich denke mal statt ActiveCell solltest Du Target schreiben:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G5:G475")) Is Nothing Then
If ActiveCell.Font.ColorIndex = 5 Then
Worksheets("Detail6").Range("E1") = Target.Value
Else
MsgBox "Keine Produkt-Gruppe der Stufe 5 ausgewählt"
Exit Sub
End If
End If
End Sub

Denn ActiveCell springt schon wieder woanders hin, je nach Cursortaste :-)
Target hingegen bezeichnet die geänderte(n) Zelle(n).
Besser wäre insofern folgendes:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim z As Range
For Each z In Target
If Not Intersect(z, Range("G5:G475")) Is Nothing Then
If ActiveCell.Font.ColorIndex = 5 Then
Worksheets("6").Range("E1") = z
Else
MsgBox "Keine Produkt-Gruppe der Stufe 5 ausgewählt"
Exit Sub
End If
End If
Next z
End Sub

Hier wird jedes Element von Target durchlaufen, falls mehrere Zellen ausgewählt sind.
Sonst kommt es schnell zu Fehlermeldungen, z.B. Taget.Value=12 geht mit mehreren Zellen nicht.
Viel Erfolg,
Matthias
Anzeige
AW: Zellen auslesen und kopieren
Torsten
Hallo Matthias,
vielen Dank für Deinen ausführlichen Lösungsansatz.
Ich werd mal schauen, wie ich das in meinen Code einbauen kann.
Nochmals schönen Dank für Deine Mühe.
Gruß
Torsten
AW: Danke für die Rückmeldung - o.T.
01.04.2004 15:57:31
Matthias
:-)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige