Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
776to780
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
776to780
776to780
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Spalten überwachen

Spalten überwachen
29.06.2006 10:59:37
Bal
Hallo Excel Profis,
Diese Code habe ich vor einige zeit hier bei Herber-Forum bekommen. Jetz möchte ich diese Code erweitern. Ich brauche ihre hilfe.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim arrT(), ii, intSum As Integer, strT As String
arrT = Array(1, 10, 55)
If Intersect([D1:D30], Target) Is Nothing Then Exit Sub
For ii = 0 To UBound(arrT)
intSum = intSum + WorksheetFunction.CountIf([D1:D30], arrT(ii))
strT = strT & " " & arrT(ii)
Next ii
If intSum > 4 Then
Application.EnableEvents = False
Target.ClearContents
Target.Select
Application.EnableEvents = True
MsgBox "Es gibt schon vier Einträge" & strT
End If
End Sub

Meine Frage: Wie kann ich diese Cod für einzelner Spalte überwachen.
Bei den Cod läuft nur für spalte D1:D30 ich möchte aber auch für andere Spalte einzeln überwacht wird .
ich höffe ich habe richtig ausdrückt.
Für jeden hilfe bin ich dankbar!
mfg
Bal

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalten überwachen
01.07.2006 11:14:55
Gerd
Hallo Bal,
probiers mal so.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim arrT() As Variant, ii As Integer, intSum As Integer, strT As String
arrT = Array(1, 10, 55)
'Änderungen nur bis Zeile 30 prüfen (1.Variante, bei 2.Variante weglassen)
If Intersect(Target, Range(Cells(1, Target.Column), Cells(30, Target.Column))) _
Is Nothing Then Exit Sub
For ii = 0 To UBound(arrT)
'1.Variante: Zeilen 1 bis 30 prüfen
intSum = intSum + WorksheetFunction.CountIf _
(Range(Cells(1, Target.Column), Cells(30, Target.Column)), arrT(ii))
'2.Variante: ganze Spalte überprüfen
'intSum = intSum + WorksheetFunction.CountIf _
(Columns(Target.Column), arrT(ii))
strT = strT & " " & arrT(ii)
Next ii
If intSum > 4 Then
Application.EnableEvents = False
Target.ClearContents
Target.Select
Application.EnableEvents = True
MsgBox "Es gibt schon vier Einträge" & strT
End If
End Sub

Gruß
Gerd
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige