Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("a1").Address Then [b1] = [b1] + 1
End Sub
Die Datei https://www.herber.de/bbs/user/11335.xls wurde aus Datenschutzgründen gelöscht
zählt folgender Code Änderungen von A1 in B1 hoch.
Dim AlterWert As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
zelle = "A1"
If Target.Address(0, 0) <> zelle Or Target.Cells.Count > 1 Then Exit Sub
If Worksheets("Tabelle1").Range(zelle).Value <> AlterWert Then
Worksheets("Tabelle1").Range("B1") = Worksheets("Tabelle1").Range("B1") + 1
End If
AlterWert = Worksheets("Tabelle1").Range(zelle).Value
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
zelle = "A1"
If Target.Address(0, 0) <> zelle Or Target.Cells.Count > 1 Then Exit Sub
AlterWert = Worksheets("Tabelle1").Range(zelle)
End Sub
Sub wenn_schon_dann_ohne_select()
Dim pf As Shape
ZelleA = InputBox("erste Zelle")
ZelleB = InputBox("zweite Zelle")
Ax = Range(ZelleA).Left + Range(ZelleA).Width / 2
Ay = Range(ZelleA).Top + Range(ZelleA).Height / 2
Bx = Range(ZelleB).Left + Range(ZelleB).Width / 2
By = Range(ZelleB).Top + Range(ZelleB).Height / 2
Set pf = ActiveSheet.Shapes.AddLine(Ax, Ay, Bx, By)
pf.Line.EndArrowheadStyle = msoArrowheadTriangle
pf.Line.EndArrowheadLength = msoArrowheadLengthMedium
pf.Line.EndArrowheadWidth = msoArrowheadWidthMedium
End Sub