Ich habe alles genauso gemacht, bekomme dennoch einen "Laufzeitfehler '1004' Anwendungs- und objektdefinierter Fehler".
For Each it In Intersect(Selection.EntireRow, Range("J6:ON14")).SpecialCells(-4144)
If Intersect(it.Offset(y), Intersect(Selection.EntireRow, Range("J6:ON14")).SpecialCells(-4144)) Is Nothing Then it.Offset(y).AddComment
c00 = it.Offset(y).Comment.Text
it.Offset(y).Comment.Text it.Comment.Text
If c00 <> "" Then it.Comment.Text c00
Next
Der unterstrichene Part wird mir dann nach dem debuggen angezeigt...
Mach ich vielleicht was verkehrt?
Hast du den Code in der angehängte Datei getestet ?
Die 'ActiveCell' sol in eine Zeile mit Zellen mit Comments stehen.
Ich kann nicht sehen welche Wert Variabele 'y' hat.
Ich sehe überhaupt nicht in welcher Datei du arbeitest.
... Bist Du jetzt vielleicht in Zeile 1 gewesen?
Ich habe den Code an einen Spinbutton angepasst, und zwar wie folgt:
Code:
Sub M_snb(y As Integer)
For Each it In Intersect(Selection.EntireRow, Range("L6:ON15")).SpecialCells(-4144)
If Intersect(it.Offset(y), Intersect(Selection.EntireRow, Range("L6:ON15")).SpecialCells(-4144)) Is Nothing Then it.Offset(y).AddComment
c00 = it.Offset(y).Comment.Text
it.Offset(y).Comment.Text it.Comment.Text
If c00 <> "" Then it.Comment.Text c00
Next
End Sub
Code:
Private Sub SpinButton1_SpinDown()
M_snb (1)
End Sub
Private Sub SpinButton1_SpinUp()
M_snb (-1)
End Sub
Ich habe im Zellbereich L6:ON15 gearbeitet.
Ich füge meine Datei einfach nochmal mit ein.
Viele Grüße!!!
Code:
Sub M_snb(y As Integer)
For Each it In Intersect(Selection.EntireRow, Range("L6:ON15")).SpecialCells(-4144)
If Intersect(it.Offset(y), Range("L6:ON15")).SpecialCells(-4144) Is Nothing Then it.Offset(y).AddComment
c00 = it.Offset(y).Comment.Text
it.Offset(y).Comment.Text it.Comment.Text
If c00 <> "" Then it.Comment.Text c00
Next
End Sub
Lösche alle verbundene Zellen !
Hallo Marcel,
Du kannst es ja auch mal damit testen:
Code:
Sub KommentareTauschen(lngZ As Long)
Dim oWsA As Worksheet
Dim oWsT As Worksheet
Dim rngA As Range
ActiveCell.Activate
If ActiveCell.Row > 5 And lngZ + ActiveCell.Row > 5 Then
Application.ScreenUpdating = False
Set oWsA = ActiveSheet
Set rngA = Intersect(ActiveCell.EntireRow, Range("H:ON"))
Set oWsT = Workbooks.Add(-4167).Worksheets(1)
rngA.Copy oWsT.Cells(1, 1)
rngA.ClearComments
rngA.Offset(lngZ).Copy oWsT.Cells(2, 1)
rngA.Offset(lngZ).ClearComments
oWsT.Cells(1, 1).Resize(, rngA.Columns.Count).Copy
rngA.Offset(lngZ).PasteSpecial Paste:=xlPasteComments
oWsT.Cells(2, 1).Resize(, rngA.Columns.Count).Copy
rngA.Offset(0).PasteSpecial Paste:=xlPasteComments
Application.CutCopyMode = False
oWsT.Parent.Close False
ActiveCell.Select
Application.ScreenUpdating = True
End If
End Sub
[
attachment=50124]
Gruß, Uwe
@snb:
Bei deinem Code erhalte ich erneut einen "Laufzeitfehler 91: Objektvariable oder With-Blockvariable nicht festgelegt".
Code:
Sub M_snb(y As Integer)
For Each it In Intersect(Selection.EntireRow, Range("L6:ON15")).SpecialCells(-4144)
If Intersect(it.Offset(y), Range("L6:ON15")).SpecialCells(-4144) Is Nothing Then it.Offset(y).AddComment
c00 = it.Offset(y).Comment.Text
it.Offset(y).Comment.Text it.Comment.Text
If c00 <> "" Then it.Comment.Text c00
Next
End Sub
Nach dem debuggen wird mir der Code-Teil:
c00 = it.Offset(y).Comment.Text angemarkert.
Ich habe keinerlei verbundene Zellen im benannten Bereich. Ich habe Zellen markiert, welche Kommentare enthalten und auch Zellen ohne Kommentare.
@Kuwer:
Super, dein Code macht das was er soll. Gibt es aber die Möglichkeit, dass nach Ausführung die betreffende Zeile "markiert" bleibt und ich diese weiter nach oben oder nach unten verschieben kann?
Ich kann Euch gar nicht genug für euren Ehrgeiz, mir bei dem "Problem" zu helfen, bedanken!!!
Hallo Marcel,
Code:
Sub KommentareTauschen(lngZ As Long)
Dim oWsA As Worksheet
Dim oWsT As Worksheet
Dim rngZ As Range
ActiveCell.Activate
If ActiveCell.Row > 5 And lngZ + ActiveCell.Row > 5 Then
Application.ScreenUpdating = False
Set oWsA = ActiveSheet
Set rngZ = Intersect(ActiveCell.EntireRow, Range("H:ON"))
Set oWsT = Workbooks.Add(-4167).Worksheets(1)
rngZ.Copy oWsT.Cells(1, 1)
rngZ.ClearComments
rngZ.Offset(lngZ).Copy oWsT.Cells(2, 1)
rngZ.Offset(lngZ).ClearComments
oWsT.Cells(1, 1).Resize(, rngZ.Columns.Count).Copy
rngZ.Offset(lngZ).PasteSpecial Paste:=xlPasteComments
oWsT.Cells(2, 1).Resize(, rngZ.Columns.Count).Copy
rngZ.Offset(0).PasteSpecial Paste:=xlPasteComments
Application.CutCopyMode = False
oWsT.Parent.Close False
rngZ.Offset(lngZ).Select
Application.ScreenUpdating = True
End If
End Sub
Gruß, Uwe
Zitat:Ich habe Zellen markiert, welche Kommentare enthalten und auch Zellen ohne Kommentare.
du brauchtst nur 1 Zelle im Gebiet J6:ON14 für +1 , oder J5:ON15 für -1 zu selektieren
Teste mal:
PHP-Code:
Sub M_snb(y As Integer)
If Selection.Row < 7 And y = -1 Or Selection.Row > 14 And y = 1 Then Exit Sub
For Each it In Intersect(Selection.EntireRow, Range("L6:ON15")).SpecialCells(-4144)
If Intersect(it.Offset(y), Range("L6:ON15").SpecialCells(-4144)) Is Nothing Then it.Offset(y).AddComment
c00 = it.Offset(y).Comment.Text
it.Offset(y).Comment.Text it.Comment.Text
If c00 <> "" Then it.Comment.Text c00
Next
End Sub
@Kuwer:
Vielen, vielen Dank!!! Jetzt erfüllt es alles, was ich mir wünsche! Super!!!
@snb:
Auch dein Code tut was es soll, er tauscht die Kommentare. Allerdings tauscht er nicht eine Zelle mit Kommentar gegen eine Zelle ohne Kommentar sondern kopiert diesen in die leere Zelle.
Viele Grüße an Euch beide!!!...ich bin begeistert!!!