Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
308to312
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
308to312
308to312
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Worksheet_Change: mehrere Zellen auswählen

Worksheet_Change: mehrere Zellen auswählen
16.09.2003 09:08:11
Franz W.
Hallo Fachleute,

ich habe mal wieder eine Frage, von der ich nicht weiß, ob das überhaupt geht.

Mit folgendem Code setze ich je nachdem ob die Zelle leer ist oder nicht einen Kommentar ein oder lösche ihn wieder:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cmt As Comment
Dim cl As Range
Application.ScreenUpdating = False
Set cl = Target
If Not cl.Comment Is Nothing Then
cl.Comment.Delete
End If
If cl = "" Then
If cl.Column = 2 Then
Set Cmt = cl.AddComment
Cmt.Text "Zählernummer"
Cmt.Visible = True
ElseIf cl.Column = 3 Then
Else
Exit Sub
End If
With Cmt.Shape
.TextFrame.AutoSize = True
With .TextFrame.Characters.Font
.Name = "Arial"
.Size = 12
End With
End With
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End If
End Sub


Das klappt auch bestens, wenn ich lediglich eine einzige Zelle auswähle.

Wenn ich nun mehrere Zellen gleichzeitig auswähle und die "Löschen"-Taste drücke um alle auf einmal zu löschen, dann kommt bei der Zeile " If cl = "" Then " die Fehlermeldung: "Typen unverträglich" (was ja eigentlich eine falsche Dim bedeutet?!?). Gibt es dafür eine Lösung? Oder kann das gar nicht gehen?

Vielen Dank schon mal im Voraus und Grüße
Franz

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Worksheet_Change: mehrere Zellen auswählen
16.09.2003 09:18:46
Hajo_Zi
Hallo Franz

ich bin nun nicht an meinem Homecomputer. Schaue mal auf meine Homepage da gibts es ein Code für mehr als 3 bedingte Formatierungen. Dort ist es eingearbeitet falls mehr als eine Zelle ausgefüllt wird.

Adresse unter Profile links

Gruß Hajo
AW: Worksheet_Change: mehrere Zellen auswählen
16.09.2003 10:14:05
Franz W.
Hallo Hajo,

vielen Dank, habs jetzt mal damit versucht:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cmt As Comment
Dim cl As Range
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("A1:Q200")
Application.ScreenUpdating = False
Set cl = Target
If Not cl.Comment Is Nothing Then
cl.Comment.Delete
End If
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If cl.Column = 2 Then
Set Cmt = cl.AddComment
Cmt.Text "Zählernummer"
Cmt.Visible = True
Else
Exit Sub
End If
With Cmt.Shape
.TextFrame.AutoSize = True
With .TextFrame.Characters.Font
.Name = "Arial"
.Size = 12
End With
End With
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End If
Next
End Sub



aber auch hier hab ich dasselbe Problem wie bei UDos Vorschlag: er mault bei der Zeile:

Set Cmt = " cl.AddComment " mit der Meldung: " Ungültiger Prozeduraufruf oder ungütliges Argument."

Ändere ich das in " Set Cmt = c.AddComment ", kommt die Meldung: " Anwendungs- oder objektorientierter Fehler. "
Anzeige
Die hier ist richtig!!
16.09.2003 10:16:02
Franz W.
Hallo Hajo,

vielen Dank, habs jetzt mal damit versucht:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cmt As Comment
Dim cl As Range
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("A1:Q200")
Application.ScreenUpdating = False
Set cl = Target
If Not cl.Comment Is Nothing Then
cl.Comment.Delete
End If
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If cl.Column = 2 Then
Set Cmt = cl.AddComment
Cmt.Text "Zählernummer"
Cmt.Visible = True
Else
Exit Sub
End If
With Cmt.Shape
.TextFrame.AutoSize = True
With .TextFrame.Characters.Font
.Name = "Arial"
.Size = 12
End With
End With
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End If
Next
End Sub



aber auch hier hab ich dasselbe Problem wie bei UDos Vorschlag: er mault bei der Zeile:

Set Cmt = " cl.AddComment " mit der Meldung: " Ungültiger Prozeduraufruf oder ungütliges Argument."

Danke und Grüße
Franz

P.S.: Die vorige Nachricht ist aus Versehen rausgerutscht, sorry
Anzeige
AW: Die hier ist richtig!!
16.09.2003 10:31:11
Hajo_Zi
Hallo Franz

in Deinem Code wurde Application.ScreenUpdating nicht wieder eingeschaltet.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cmt As Comment
Dim cl As Range
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("A1:Q200")
Application.ScreenUpdating = False
Set cl = Target
If Not cl.Comment Is Nothing Then cl.Comment.Delete
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If cl.Column = 2 Then
With cl
.AddComment
.Comment.Text "Zählernummer"
.Comment.Visible = True
With .Comment.Shape.TextFrame
.AutoSize = True
.Characters.Font.Name = "Arial"
.Characters.Font.Size = 12
End With
End With
Else
GoTo Ende
End If
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End If
Next
Ende:
Set RaBereich = Nothing
Set cl = Nothing
Application.ScreenUpdating = True
End Sub


Gruß Hajo
Anzeige
Leider noch nicht...
16.09.2003 11:00:46
Franz W.
Hallo Hajo,

toll Dein Code! Schaut schon gleich viel sauberer aus als meiner (ob ich das auch mal noch lerne...???)

Application.ScreenUpdating = True: stimmt, hab ich noch vergessen.

Aber leider gibt es noch zwei Probleme:

1. Wenn ich mehrere Zellen markiert habe und Delete drücke, kommt jetzt eine Fehlermeldung bei: " .AddComment " und zwar: " Anwendungs- oder objektorientierter Fehler. "

2. Wenn ich jetzt in eine Zelle der Spalte B etwas eintrage, bleibt der Kommentar bestehen. Da sollte er eigentlich weg. Der Kommentar sollte nur in einer leeren Zelle stehen, sollte also geschrieben werden, wenn der Inhalt der Zelle gelöscht wird und verschwinden, wenn was eingetragen wird.

Grüße
Franz
Anzeige
AW: Leider noch nicht...
16.09.2003 11:06:10
Hajo_Zi
Hallo Franz

ich habe auf Deinen Code aufgebaut. Jetzt habe ich mir das nochmal vorgenommen. Aber irgendwie fehlt mir noch der Zusammenhang. Ich Vermute mal wenn keine Inhalt in der Zelle dann soll auch kein Kommenmtar??


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cmt As Comment
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("A1:Q200")
Application.ScreenUpdating = False
Set cl = Target
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If RaZelle.Column = 2 Then
If Not RaZelle.Comment Is Nothing Then RaZelle.Comment.Delete
With RaZelle
.AddComment
.Comment.Text "Zählernummer"
.Comment.Visible = True
With .Comment.Shape.TextFrame
.AutoSize = True
.Characters.Font.Name = "Arial"
.Characters.Font.Size = 12
End With
End With
Else
GoTo Ende
End If
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End If
Next
Ende:
Set RaBereich = Nothing
Application.ScreenUpdating = True
End Sub


Gruß Hajo
Anzeige
AW: Leider noch nicht...
16.09.2003 11:09:48
Franz W.
Hallo Hajo,

doch, genau umgekehrt: wenn kein Inhalt, dann Kommentar. Wenn Inhalt, dann kein Kommentar. Sinn: es geht um viele Zellen (auch noch in anderen Spalten, das füge ich noch ein. Die bekommen dann andere Kommentare). Diese Zelle sind i. d. R. gefüllt. Als kleine Hilfe, falls eine Zelle leer ist, soll der Kommentar dann anzeigen, was rein soll.Drum soll er verschwinden, wenn was drin steht.

Grüße
Franz
AW: Leider noch nicht...
16.09.2003 11:28:09
Hajo_Zi
Hallo Franz

ich habe mal paar Kommentare geschrieben


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cmt As Comment
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("A1:Q200")
Application.ScreenUpdating = False
Set cl = Target
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If RaZelle.Column = 2 Then  ' Kommentare nur in Spalte B
If Not RaZelle.Comment Is Nothing Then RaZelle.Comment.Delete
If RaZelle = Empty Then
' vorhandene Kommentare löschen
With RaZelle
.AddComment
.Comment.Text "Zählernummer"
' braucht nicht sein
'.Comment.Visible = True
With .Comment.Shape.TextFrame
.AutoSize = True
.Characters.Font.Name = "Arial"
.Characters.Font.Size = 12
End With
End With
End If
' Else
'GoTo Ende
' Warum Ende sobald eine Zelle nicht in Spalte B wird For Next Schleife verlassen
' und die restlichen Zellen werden nicht mehr abgearbeitet
End If
' diese Anweisung ist mir nicht ganz klar
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End If
Next
'Ende:
Set RaBereich = Nothing
Application.ScreenUpdating = True
End Sub


Gruß Hajo
Anzeige
Jaa!! So tut er's !!
16.09.2003 11:59:33
Franz W.
Hallo Hajo,

toll, ganz vielen Dank. So klappt er in allen Variationen. Auch mit meinen Erweiterungen für andere Spalten (Code siehe unten)! Hab da noch nicht alle drin, da kommen noch 4 Stück dazu.

Und drum hätte ich noch eine abschließende Frage, wenn Du noch magst: ich könnte mit dem Code schon leben, auch wenn er kilometerlang ist. Er klappt ja. Aber gibt es theoretisch da noch eine Möglichkeit, das zu verkürzen? Ist das überhaupt möglich, da ja für jede Spalte was anderes in den Kommentar eingetragen wird? Falls ja, in welche Richtung müsste ich da denken? Nur einen Ansatz bitte, sollte dann schon selber irgendwie klar kommen, denke ich.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cmt As Comment
Dim cl As Range, RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("A1:Q200")
Application.ScreenUpdating = False
Set cl = Target
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If RaZelle.Column = 2 Then  ' Kommentare nur in Spalte B
If Not RaZelle.Comment Is Nothing Then RaZelle.Comment.Delete
If RaZelle = Empty Then
' vorhandene Kommentare löschen
With RaZelle
.AddComment
.Comment.Text "Zählernummer"
With .Comment.Shape.TextFrame
.AutoSize = True
.Characters.Font.Name = "Arial"
.Characters.Font.Size = 12
End With
End With
End If
ElseIf RaZelle.Column = 3 Then  ' Kommentare nur in Spalte B
If Not RaZelle.Comment Is Nothing Then RaZelle.Comment.Delete
If RaZelle = Empty Then
' vorhandene Kommentare löschen
With RaZelle
.AddComment
.Comment.Text "Kd.-Nr."
With .Comment.Shape.TextFrame
.AutoSize = True
.Characters.Font.Name = "Arial"
.Characters.Font.Size = 12
End With
End With
End If
ElseIf RaZelle.Column = 6 Then  ' Kommentare nur in Spalte B
If Not RaZelle.Comment Is Nothing Then RaZelle.Comment.Delete
If RaZelle = Empty Then
' vorhandene Kommentare löschen
With RaZelle
.AddComment
.Comment.Text "Ablesung 1. Quartal"
With .Comment.Shape.TextFrame
.AutoSize = True
.Characters.Font.Name = "Arial"
.Characters.Font.Size = 12
End With
End With
End If
ElseIf RaZelle.Column = 8 Then  ' Kommentare nur in Spalte B
If Not RaZelle.Comment Is Nothing Then RaZelle.Comment.Delete
If RaZelle = Empty Then
' vorhandene Kommentare löschen
With RaZelle
.AddComment
.Comment.Text "Ablesung 2. Quartal"
With .Comment.Shape.TextFrame
.AutoSize = True
.Characters.Font.Name = "Arial"
.Characters.Font.Size = 12
End With
End With
End If
ElseIf RaZelle.Column = 10 Then  ' Kommentare nur in Spalte B
If Not RaZelle.Comment Is Nothing Then RaZelle.Comment.Delete
If RaZelle = Empty Then
' vorhandene Kommentare löschen
With RaZelle
.AddComment
.Comment.Text "Ablesung 3. Quartal"
With .Comment.Shape.TextFrame
.AutoSize = True
.Characters.Font.Name = "Arial"
.Characters.Font.Size = 12
End With
End With
End If
ElseIf RaZelle.Column = 12 Then  ' Kommentare nur in Spalte B
If Not RaZelle.Comment Is Nothing Then RaZelle.Comment.Delete
If RaZelle = Empty Then
' vorhandene Kommentare löschen
With RaZelle
.AddComment
.Comment.Text "Ablesung 4. Quartal"
With .Comment.Shape.TextFrame
.AutoSize = True
.Characters.Font.Name = "Arial"
.Characters.Font.Size = 12
End With
End With
End If
End If
' diese Anweisung ist mir nicht ganz klar
'Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End If
Next
Set RaBereich = Nothing
Application.ScreenUpdating = True
End Sub


Vielen Dank und Grüße
Franz
Anzeige
Kommentar in mehreren Spalten
16.09.2003 12:32:38
Hajo_Zi
Hallo Franz

mal ungetestet


Private Sub Worksheet_Change(ByVal Target As Range)
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("A1:Q200")
Application.ScreenUpdating = False
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If RaZelle.Column = 2 Or RaZelle.Column = 3 Or _
RaZelle.Column = 6 Or RaZelle.Column = 8 Or _
RaZelle.Column = 10 Or RaZelle.Column = 12 Then
' vorhandene Kommentare löschen
If Not RaZelle.Comment Is Nothing Then RaZelle.Comment.Delete
If RaZelle = Empty Then
With RaZelle
.AddComment
Select Case RaZelle.Column
Case 2
.Comment.Text "Zählernummer"
Case 3
.Comment.Text "Kd.-Nr."
Case 6
.Comment.Text "Ablesung 1. Quartal"
Case 8
.Comment.Text "Ablesung 2. Quartal"
Case 10
.Comment.Text "Ablesung 3. Quartal"
Case 12
.Comment.Text "Ablesung 4. Quartal"
End Select
With .Comment.Shape.TextFrame
.AutoSize = True
.Characters.Font.Name = "Arial"
.Characters.Font.Size = 12
End With
End With
End If
End If
End If
Next
Set RaBereich = Nothing
Application.ScreenUpdating = True
End Sub


Gruß Hajo
Anzeige
AW: Jaa!! So tut er's !!
16.09.2003 12:40:02
xXx
Hallo,
da bin ich wieder.
1. Die Kommentartexte würde ich als Array definieren z.B.strKomm(2)="Kommentar2", strKomm(3)="Kommentar2 etc. Index immer wie die Spalte in die sie gehören.
2. Die If/ElseIf-bedingungen durch select case ersetzen.
Select Case RaZelle.Column
Case 2, 3, 6, 8, 10, 12
If Not RaZelle.Comment Is Nothing Then RaZelle.Comment.Delete
If RaZelle = Empty Then
' vorhandene Kommentare löschen
With RaZelle
.AddComment
.Comment.Text strkomm(RaZelle.column)
With .Comment.Shape.TextFrame
.AutoSize = True
.Characters.Font.Name = "Arial"
.Characters.Font.Size = 12
End With
End With
end select

Das ist jetzt mit der heißen Nadel gestrick und soll wirklich nur als Ansatz dienen.
Den Code solltest du aber so stark verkürzen können.

Gruß aus'm Pott
Udo
Anzeige
IHR SEID SUPER !!!
16.09.2003 13:00:41
Franz W.
Hallo Hajo, hallo Udo,

ich find das echt toll von Euch!!

Schon Dein vorgezeichneter Weg, Udo ... wie kriegt man so schnell mal einen Ansatz aus dem Ärmel geschüttelt?!?

Und Deine Lösung, Hajo, klappt ja zu 100 Prozent!! Da wäre ich ja wohl drei Tage dran gesessen. Zumal ich Case noch nicht eingesetzt hatte, da gab's gleich mal was Neues für mich.

Ich danke Euch beiden ganz herzlich, Ihr habt mich für heute echt glücklich gemacht!!

Viele Grüße
Franz
Danke für die Rückmeldung oT
16.09.2003 13:01:40
Hajo_Zi
Nur zum Anschauen...
16.09.2003 13:39:43
Franz W.
Hallo Hajo,

weil ich das Ganze nicht für mich mache, sondern für einen Freund, und weil sich die Tabelle noch vergrößern wird, habe ich am Anfang noch was rein, um den Bereich der Wirksamkeit variabel zu gestalten. Hier der Anfang vom Code:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim a&, b As Byte
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set ws = ActiveSheet
a = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
b = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1
Set RaBereich = Range(Cells(1, 1), Cells(a, b))
Application.ScreenUpdating = False
Worksheets("Ablesungen").Unprotect
For Each RaZelle In Range(Target.Address)
End Sub


Grüße
Franz
AW: Worksheet_Change: mehrere Zellen auswählen
16.09.2003 09:18:53
xXx
Hallo,
einen Bereich aus mehreren Zellen kannst du nicht auf "" abfragen.
Mach's so:

For each c in cl.cells
if c="" then
.
.
next c

Gruß aus'm Pott
Udo
Danke, aber Folgeproblem
16.09.2003 09:44:07
Franz W.
Hallo Udo,

vielen Dank für Deine Hilfe, aber jetzt mault er bei der Zeile:

Set Cmt = " cl.AddComment " mit der Meldung: " Ungültiger Prozeduraufruf oder ungütliges Argument."

Ändere ich das in " Set Cmt = c.AddComment ", kommt die Meldung: " Anwendungs- oder objektorientierter Fehler. "

Das weiß ich leider nicht weiter, kannst Du mir bitte nochmal helfen?

Vielen Dank und Grüße
Franz

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige