Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1108to1112
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
Inhaltsverzeichnis

Kommentar aus Zellbereich

Kommentar aus Zellbereich
Werner
Hallo zusammen,
mit den folgenden Makro wird in Zelle A1 der Bereich B5:N8 als Kommentar angezeigt..........
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim Ausgabe As String
Ausgabe = ""
For Each Zelle In Range("B5:N8")
Ausgabe = Ausgabe & Zelle
Next
With Range("A1")
If .Comment Is Nothing Then
.AddComment
End If
.Comment.Text Text:=""
.Comment.Text Text:=Ausgabe
End With
End Sub

....gibt es eine Möglichkeit im selben Tabellenblatt das ganze mit mehreren Bereichen zu machen, und wie müsste das aussehen ?
in Zelle A1 soll der Bereich von B5:N8
in Zelle A2 der Bereich von C7:D9
in Zelle A3 der Bereich von H5:L9
.........
..........
angezeigt werden. Wie müsste ich das Makro dan Schreiben.
Viele Grüße Werner

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Analog! Du musst vor End Sub nur noch 2x...
11.10.2009 23:01:57
Luc:-?
...den gesamten Komplex von For Each... bis End With mit entsprechend geänderten Bezügen einfügen, Werner!
Gruß Luc :-?
AW: Kommentar aus Zellbereich
11.10.2009 23:08:16
Tino
Hallo,
versuche es mal so.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle1 As Range, Zellen As Range, A As Long
Dim Ausgabe As String

Set Zelle1 = Union(Range("B5:N8"), Range("C7:D9"), Range("H5:L9"))

If Not Intersect(Zelle1, Target) Is Nothing Then
    For A = 1 To Zelle1.Areas.Count
      
           With Application
               Ausgabe = ""
               For Each Zellen In Zelle1.Areas(A).Rows
                Ausgabe = Ausgabe & Join(.Transpose(.Transpose(Zellen)), "")
               Next Zellen
           End With
           
           With Range("A1:A3")(A)
               If .Comment Is Nothing Then
                .AddComment
               End If
               .Comment.Text Text:=""
               .Comment.Text Text:=Ausgabe
          End With
    
    Next A
End If

End Sub
Gruß Tino
Anzeige
besser...
12.10.2009 07:27:42
Tino
Hallo,
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle1 As Range, Zellen As Range, A As Long
Dim Ausgabe As String

Set Zelle1 = Union(Range("B5:N8"), Range("C7:D9"), Range("H5:L9"))

If Not Intersect(Zelle1, Target) Is Nothing Then
    For A = 1 To Zelle1.Areas.Count
      If Not Intersect(Zelle1.Areas(A), Target) Is Nothing Then
           With Application
               Ausgabe = ""
               For Each Zellen In Zelle1.Areas(A).Rows
                Ausgabe = Ausgabe & Join(.Transpose(.Transpose(Zellen)), "")
               Next Zellen
           End With
           
           With Range("A1:A3")(A)
               If .Comment Is Nothing Then
                .AddComment
               End If
               .Comment.Text Text:=""
               .Comment.Text Text:=Ausgabe
          End With
       End If
    Next A
End If

End Sub
Gruß Tino
Anzeige
AW: besser...
12.10.2009 19:04:57
Werner
Hallo,
ich habe folgendes probiert.....
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim Ausgabe As String
Ausgabe = ""
For Each Zelle In Range("B5:N8")
Ausgabe = Ausgabe & Zelle
Next
With Range("A1")
If .Comment Is Nothing Then
.AddComment
End If
.Comment.Text Text:=""
.Comment.Text Text:=Ausgabe
End With
For Each Zelle In Range("f1:h3")
Ausgabe = Ausgabe & Zelle
Next
With Range("A2")
If .Comment Is Nothing Then
.AddComment
End If
.Comment.Text Text:=""
.Comment.Text Text:=Ausgabe
End With
End Sub
mit Zelle A1 klapt das aber in Zelle A2 wird der Bereich B5:N8 und der Bereich f1:h3 angezeigt, es soll aber nur der Bereich f1:hr angezeigt werden. Wo hab ich da den Fehler?
Gruß Werner
Anzeige
Funktioniert mein Code bei Dir nicht?
12.10.2009 19:31:51
Tino
Hallo,
zu Deiner Frage,
bevor Du in den zweiten Bereich gehst, musst Du 'Ausgabe' wieder leer machen
also vor der zweiten For Next Schleife Ausgabe = ""
Gruß Tino
AW: besser...
12.10.2009 19:33:59
Gerd
Hallo Werner,
schreibe
Ausgabe = ""
über die zweite For ... Each - Schleife.
Der Code von Tino hat mir besser gefallen. :-)
Gruß Gerd
AW: besser...
12.10.2009 20:57:28
Werner
Hallo Gerd Hallo Tino,
Danke für die tollen Tips :-) :-)
ich hab es folgendermaßen gelöst.....
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim Ausgabe As String
Ausgabe = ""
For Each Zelle In Range("B5:N8")
Ausgabe = Ausgabe & Zelle
Next
With Range("A1")
If .Comment Is Nothing Then
.AddComment
End If
.Comment.Text Text:=""
.Comment.Text Text:=Ausgabe
End With
Ausgabe = ""
For Each Zelle In Range("F5:H5")
Ausgabe = Ausgabe & Zelle
Next
With Range("A2")
If .Comment Is Nothing Then
.AddComment
End If
.Comment.Text Text:=""
.Comment.Text Text:=Ausgabe
End With
End Sub
....da ich verschiedene Zellbereiche habe (A1,A2,C3,D5...) in die der Kommentar soll, war für mich die einfachste Lösung.
Viele Grüße Werner
Anzeige
AW: besser...
12.10.2009 21:19:22
Gerd
Jo gell', noch so einer :-)
Da Ausgabe eine lokale Variable ist, könntest Du
Ausgabe= ""
vor der ersten Schleife weglassen, weil dies ohnehin der Startwert dieser Variable ist.
Gruß Gerd
AW: besser...
12.10.2009 21:58:09
Werner
Hallo Gerd,
Danke :-) :-)
Für zusammenhängende Ausgaben ...
13.10.2009 07:39:41
Tino
Hallo,
gibt esauch eine Möglichkeiten dies etwas kompakter zu gestalten.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCheck As Range, Zellen As Range, A As Long
Dim Ausgabe As String

Set rngCheck = Union(Range("B5:N8"), Range("C7:D9"), Range("H5:L9")) 'Überwache 


If Not Intersect(rngCheck, Target) Is Nothing Then
    For A = 1 To rngCheck.Areas.Count
      If Not Intersect(rngCheck.Areas(A), Target) Is Nothing Then
           With Application
               Ausgabe = ""
               For Each Zellen In rngCheck.Areas(A).Rows
                Ausgabe = Ausgabe & Join(.Transpose(.Transpose(Zellen)), "")
               Next Zellen
           End With
           
           With Array(Range("A1"), Range("A3"), Range("A5"))(A - 1) 'Ausgabe 
               If .Comment Is Nothing Then
                .AddComment
               End If
               .Comment.Text Text:=""
               .Comment.Text Text:=Ausgabe
          End With
       End If
    Next A
End If

End Sub
Gruß Tino
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige