Anzeige
Archiv - Navigation
1268to1272
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

Nicht alles in der Zeile löschen...

Nicht alles in der Zeile löschen...
Ina
Hallo und guten Morgen zusammen,
ich habe ein Problem mit einer Lösch-Funktion.
Bisher konnten im aktiven Tabellenblatt per TextbBox Werte im Bereich B16:T110 gesucht werden.
Durch Klick auf den CommandButton 6 wurden alle Werte einfach durch Löschen der entsprechenden Zeile entfernt... Das klappte auch hervorragend (Dank an Sepp).
Jetzt stehen in einigen Zellen aber auch Formeln, sodaß nur die Werte in den Zellen (nicht aber die ganze Zeile) gelöscht werden darf.
Zellen in denen Formeln stehen: G16:G110, I16:I110, M16:M110, O16:O110, R16:R110, T16:T110
Kann mir vielleicht jemand helfen und den folgenden Code dahingehend modifizieren?
Der bisherige Code:
Private Sub CommandButton6_Click()
If Len(Trim(TextBox1)) = 0 Then MsgBox "Nichts zum Löschen da!         ", 64, " Hinweis  :-)":   _
_
Exit Sub
Dim Mldg, Stil, Titel, Ktxt, Antwort, Text
Beep
Mldg = "  Daten wirklich löschen?  " & Chr(13) _
Stil = vbYesNo + vbQuestion + vbDefaultButton1
Titel = " Information"
Ktxt = 1000
Antwort = MsgBox(Mldg, Stil, Titel, Hilfe, Ktxt)
If Antwort = vbNo Then
Text = "Nein"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Exit Sub
ElseIf Antwort = vbYes Then
Text = "Ja"
Dim intZ As Integer
Dim sh As Worksheet
'Set sh = Worksheets("Tabelle1")
Set sh = ActiveSheet
Dim durchsuchen, finden As Range
Set durchsuchen = sh.Range("b16:d" & _
sh.Range("B65536").End(xlUp).Row)
For Each finden In durchsuchen
If finden.Text = TextBox1.Text Then
intZ = finden.Row
Exit For
End If
Next finden
ActiveSheet.Unprotect
sh.Rows(intZ).Delete
ActiveSheet.Protect
For IntC = 1 To 19
Controls("TextBox" & IntC) = ""
Next
MsgBox "Der Datensatz wurde gelöscht.  ", 64, " Hinweis  :-)"
Exit Sub
End If
End Sub

LG Ina

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Nicht alles in der Zeile löschen...
19.07.2012 15:42:34
fcs
Hallo Ina,
das Makro sucht ja nur in den Spalten B bis D. In soweit spielen die Zellbereiche mit den Formeln keine Rolle, da sie außerhalb des zu durchsuchenden Bereichs liegen.
Frage: Steht der zu suchende Text immer nur einmal im Bereich B16:Dxxx?
Das Makro wird jedenfals immer nach löschen der 1. Fundstelle beendet.
Gruß
Franz
Private Sub CommandButton6_Click()
If Len(Trim(TextBox1)) = 0 Then MsgBox "Nichts zum Löschen da!     ", 64, " Hinweis  :-)" _
: Exit Sub
Dim Mldg, Stil, Titel, Ktxt, Antwort, Text
Beep
Mldg = "  Daten wirklich löschen?  " & Chr(13) _
Stil = vbYesNo + vbQuestion + vbDefaultButton1
Titel = " Information"
Ktxt = 1000
Antwort = MsgBox(Mldg, Stil, Titel, Hilfe, Ktxt)
If Antwort = vbNo Then
Text = "Nein"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Exit Sub
ElseIf Antwort = vbYes Then
Text = "Ja"
Dim intZ As Integer
Dim sh As Worksheet
'Set sh = Worksheets("Tabelle1")
Set sh = ActiveSheet
Dim durchsuchen, finden As Range
Set durchsuchen = sh.Range("b16:d" & _
sh.Range("B65536").End(xlUp).Row)
For Each finden In durchsuchen
If finden.Text = TextBox1.Text Then
intZ = finden.Row
Exit For
End If
Next finden
If intZ > 0 Then
ActiveSheet.Unprotect
finden.ClearContents
ActiveSheet.Protect
MsgBox "Der Zelleninhalt wurde gelöscht.  ", 64, " Hinweis  :-)"
Else
MsgBox "Suchbegriff nicht gefunden", vbInformation + vbOKOnly, "Hinweis"
End If
For IntC = 1 To 19
Controls("TextBox" & IntC) = ""
Next
Exit Sub
End If
End Sub

Anzeige
AW: Nicht alles in der Zeile löschen...
19.07.2012 15:46:16
Ina
Hallo Franz,
der zu suchende Text kommt im Regelfall (außer Datums- und Namenwerte) nur einmal vor.
Gruß, Ina
AW: Nicht alles in der Zeile löschen...
19.07.2012 16:53:27
fcs
Hallo Ina,
wenn der Suchbegriff mehrfach vorkommen kann, dann sollte die Suchschleife alle Zellen durchsuchen und nicht nach der 1. Fundstelle verlassen werden.
Dann muss der folgende Abschnitt des Makros etwas modifiziert werden.
Gruß
Franz
  ElseIf Antwort = vbYes Then
Text = "Ja"
Dim intZ As Integer
Dim sh As Worksheet
'Set sh = Worksheets("Tabelle1")
Set sh = ActiveSheet
Dim durchsuchen, finden As Range
Set durchsuchen = sh.Range("b16:d" & _
sh.Range("B65536").End(xlUp).Row)
ActiveSheet.Unprotect
For Each finden In durchsuchen
If finden.Text = TextBox1.Text Then
intZ = finden.Row
finden.ClearContents
End If
Next finden
ActiveSheet.Protect
If intZ > 0 Then
MsgBox "Der Zelleninhalt wurde gelöscht.  ", 64, " Hinweis  :-)"
Else
MsgBox "Suchbegriff nicht gefunden", vbInformation + vbOKOnly, "Hinweis  :-("
End If
For IntC = 1 To 19
Controls("TextBox" & IntC) = ""
Next
Exit Sub
End If

Anzeige
AW: Nicht alles in der Zeile löschen...
19.07.2012 18:31:06
Ina
Hallo Franz,
der Ansatz passt schon, aber es sollen ja alle Werte in der Zeile außer denen in den Zellen G16:G110, I16:I110, M16:M110, O16:O110, R16:R110 und T16:T110 (dort sind Formeln enthalten) gelöscht werden.
Noch eine Idee?
Gruß, Ina
AW: Nicht alles in der Zeile löschen...
19.07.2012 23:43:03
fcs
Hallo Ina,
mit folgenden Anpassungen sollten in der Zeile mit gefundenem Text die Inhalte aller Zellen ohne Formel gelöscht werden.
Gruß
Franz
  ElseIf Antwort = vbYes Then
Text = "Ja"
Dim intZ As Integer
Dim sh As Worksheet
'Set sh = Worksheets("Tabelle1")
Set sh = ActiveSheet
Dim durchsuchen, finden As Range, Spalte As Long
With sh
Set durchsuchen = .Range("b16:d" & .Range("B65536").End(xlUp).Row)
.Unprotect
For Each finden In durchsuchen
If finden.Text = TextBox1.Text Then
intZ = finden.Row
For Spalte = 1 To .Cells(intZ, .Columns.Count).End(xlToLeft).Column
With .Cells(intZ, Spalte)
If Not .HasFormula Then
.ClearContents
End If
End With
Next Spalte
End If
Next finden
.Protect
End With
If intZ > 0 Then
MsgBox "Der Zelleninhalt wurde gelöscht.  ", 64, " Hinweis  :-)"
Else
MsgBox "Suchbegriff nicht gefunden", vbInformation + vbOKOnly, "Hinweis  :-("
End If
For IntC = 1 To 19
Controls("TextBox" & IntC) = ""
Next
Exit Sub
End If

Anzeige
Danke Franz, das klappt perfekt... oT
20.07.2012 12:42:18
Ina
LG Ina

64 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige