Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 17:41:19
Link erstellen mit Formel oder VBA?
23.04.2024 17:00:22
Summe und Ausgabe
23.04.2024 16:27:34
Excel Starthinweis - Arbeitsmappenleistung überprüfen ...
23.04.2024 16:15:16
Mittels VBA vordefinierte Kommentare in Zellen einfügen?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1344to1348
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
1344to1348
1344to1348
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code zu langsam

Code zu langsam
09.01.2014 19:25:23
René
Hallo liebe Excelprofis,
habe einen Code in meiner Tabelle der gut funktioniert, aber langsam ist weil jedesmal die ganze Routine durchlaufen wird.
Habt ihr einen Tip wie man das ändern muss damit es schneller geht.
Bin für jede Hilfe dankbar.
Mit freundlichen Grüßen René
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim row As Integer
Dim col As Integer
For row = 1 To 10
For col = 2 To 3
If Cells(row, col)  "s" And Cells(row, col)  "x" And Cells(row, col)  "u" Then Cells(row, _
col) = ""
Next col
Next row
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Habt ihr einen Tipp ... Ja!
09.01.2014 19:30:21
Matthias
Hallo
Benutz den Code nur in dem Bereich, in dem Du ihn auch benötigst!
Sonst läuft der bei jedem Klick in jeder Zelle an.
Gruß Matthias

AW: Habt ihr einen Tipp ... Ja!
10.01.2014 08:10:18
UweD
Hallo
kann das dir helfen?
nur die ÄNDERUNGEN werden überwacht
nur der angegebene Bereich
nur die eine Zelle, die geändert wird

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
If Not Intersect(Target, Range("B1:C10")) Is Nothing Then
If Target  "s" And Target  "x" And Target  "u" And Target  "" Then
Application.EnableEvents = False
Target = ""
End If
End If
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
Application.EnableEvents = True
End Sub
Gruß UweD

Anzeige
AW: Habt ihr einen Tipp ... Ja!
10.01.2014 09:01:50
René
Hallo UweD,
vielen Dank an Dich - das ist ja SUPER.
Hab mal trotzdem noch eine Frage. Gibt es eine Möglichkeit den Code so anzupassen das man beispielsweise von B1:B10 nur einmal ein x eintragen kann, also wiegesagt in einer Spalte zum Beispiel von Zelle B1 bis Zelle B10 nur ein x möglich ist?
Das wäre der Oberhammer.
Vielen vielen vielen Dank
Es grüßt Dich René

AW: nur ein x im Bereich
10.01.2014 09:32:43
hary
Moin Rene 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
If Not Intersect(Target, Range("B1:C10")) Is Nothing Then
If Application.CountIf(Range("B1:C10"), "x") > 1 Then Application.Undo
Select Case Target
Case "s", "x", "u", "" 'wirkt nicht bei
Case Else              'sonst
Application.EnableEvents = False
Target = ""
End Select
End If
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
Application.EnableEvents = True
End Sub

gruss hary

Anzeige
AW: nur ein x im Bereich
10.01.2014 09:43:52
René
Hallo Hary,
vielen Dank, leider kann ich aber trotzdem mehrere x Werte in die Zellen B1 bis B10 eintragen?
Will aber das nur ein x in dem Bereich eingetragen werden kann. s und u wie in deinem Beispiel können wir ganz weglassen. Vielleicht mache ich einen Fehler. Code steht in dem Arbeitsblatt wo die Zellen sind

AW: nur ein x im Bereich
10.01.2014 09:55:18
UweD 

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
If Not Intersect(Target, Range("B1:C10")) Is Nothing Then
Application.EnableEvents = False
If Application.CountIf(Range("B1:B10"), "x") > 1 Then
MsgBox "x bereits vorhanden!"
Application.Undo
End If
Select Case Target
Case "x", "" 'wirkt nicht bei
Case Else              'sonst
Target = ""
End Select
End If
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
Application.EnableEvents = True
End Sub

Anzeige
AW: nur ein x im Bereich
10.01.2014 10:09:57
René
Herlichen Dank an alle, ihr habt mir sehr geholfen. Ich bin jetzt richtig froh. Das ist ein guter Tag. DANKE DANKE

ohne Code...
10.01.2014 10:17:58
UweD
Hier noch eine Lösung ohne Code
- B1 bis B10 markieren
- Daten, Datenüberprüfung
- dann so wie abgebildet einstellen
=UND(B1="x";ZÄHLENWENN($B$1:$B$10;"x")<=1)
Userbild
Gruß UweD

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige