Microsoft Excel

Herbers Excel/VBA-Archiv

Tabellenblätter nach inhalt durchsuchen und lösche

Betrifft: Tabellenblätter nach inhalt durchsuchen und lösche von: Spenski
Geschrieben am: 05.08.2014 18:37:16

Hallo

ich möchte im tabellenblatt "Control" IN Spalte B4 eine zahl eingeben. wenn ich jetzt ein makro über ein CB starte soll folgendes passieren:

durchsuche sheets(1) Spalte A nach dem inhalt (Daten B4) und lösche bei dem treffer die komplette zeile.

durchsuche sheets(2-11 und 16-17) Spalte D nach dem inhalt (Daten B4) und lösche bei übereinstimmung den zelleninhalt

optional:
ich kann nicht nur in B4 ein wert eintragen sondern in B4:B8 und danach soll dann gesucht werden

danke fürs lesen und die ganze hilfe die ich bisher bekommen habe und bekommen werde.

gruss
christian

  

Betrifft: AW: Tabellenblätter nach inhalt durchsuchen und lösche von: Christian
Geschrieben am: 05.08.2014 20:35:42

Hallo Christian,

auch hierzu ist das Archiv voll mit Vorschlägen!

ein Ansatz:

Option Explicit

Sub spenski()
Dim x As Long, y As Long, rowl As Long, rowl1 As Long
Dim wkscont As Worksheet, wksx As Worksheet
Set wkscont = ActiveWorkbook.Worksheets("Control")
With wkscont
rowl1 = ActiveWorkbook.Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
 For y = 1 To rowl1
 Set wksx = ActiveWorkbook.Worksheets("Tabelle1")
  If IsNumeric(Application.Match(wksx.Cells(y, 1), .Range(.Cells(4, 2), .Cells(8, 2)), 0)) Then
   wksx.Rows(y).ClearContents
  End If
 Next y

 For x = 2 To 11
 Set wksx = ActiveWorkbook.Worksheets("Tabelle" & x)
 rowl = wksx.Cells(Rows.Count, 4).End(xlUp).Row
  For y = 1 To rowl
   If IsNumeric(Application.Match(wksx.Cells(y, 4), .Range(.Cells(4, 2), .Cells(8, 2)), 0))  _
Then
    wksx.Rows(y).ClearContents
   End If
  Next y
 Next x

 For x = 16 To 17
 Set wksx = ActiveWorkbook.Worksheets("Tabelle" & x)
 rowl = wksx.Cells(Rows.Count, 4).End(xlUp).Row
  For y = 1 To rowl
   If IsNumeric(Application.Match(wksx.Cells(y, 4), .Range(.Cells(4, 2), .Cells(8, 2)), 0))  _
Then
    wksx.Rows(y).ClearContents
   End If
  Next y
 Next x
End With


End Sub

MfG Christian


  

Betrifft: AW: Tabellenblätter nach inhalt durchsuchen und lösche von: Spenski
Geschrieben am: 05.08.2014 20:59:30

hallo christian ... erstmal danke ich dir das du dir die mühe für den code gemacht hast.

desweiteren ist das archive das erste was ich nachschaue...aber bei 100000 einträgen das richtige zu finden ist manchmal nicht so einfach , besonders wenn man nicht genau weiss nach was man suchen soll

einiges für diesen fall hab ich schon gefunden...nur harpert es daran das ich es nur auf bestimmten arbeitsblättern anwenden will.
aber gerade wenn es ums löschen geht möchte ich nicht irgendwas von mir zusammengeflicktes, sondern was sicheres und stabiles.


ich danke dir für den code und werde jetzt damit rumtesten

gruss
christian


  

Betrifft: AW: Tabellenblätter nach inhalt durchsuchen und lösche von: Spenski
Geschrieben am: 05.08.2014 21:32:58



so hab jetzt versucht den code zu verstehen, klappt denke ich auch . hab ihn auch ein wenig verändert da die blätter nicht Tabelle 2 usw heissen.

Option Explicit

Sub spenski()
 Dim x As Long, y As Long, rowl As Long, rowl1 As Long
 Dim wkscont As Worksheet, wksx As Worksheet
 Set wkscont = ActiveWorkbook.Worksheets("Control")
 With wkscont
 rowl1 = ActiveWorkbook.Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
  For y = 1 To rowl1
  Set wksx = ActiveWorkbook.Worksheets("Tabelle1")
   If IsNumeric(Application.Match(wksx.Cells(y, 1), .Range(.Cells(4, 2), .Cells(8, 2)), 0))  _
Then
    wksx.Rows(y).ClearContents
   End If
  Next y
 
  For x = 2 To 11
  Set wksx = ActiveWorkbook.Worksheets(x)
  rowl = wksx.Cells(Rows.Count, 4).End(xlUp).Row
   For y = 1 To rowl
  If IsNumeric(Application.Match(wksx.Cells(y, 4), .Range(.Cells(4, 2), .Cells(8, 2)), 0)) Then
     wksx.Rows(y).ClearContents
    End If
   Next y
  Next x
 
  For x = 16 To 17
  Set wksx = ActiveWorkbook.Worksheets(x)
  rowl = wksx.Cells(Rows.Count, 4).End(xlUp).Row
   For y = 1 To rowl
    If IsNumeric(Application.Match(wksx.Cells(y, 4), .Range(.Cells(4, 2), .Cells(8, 2)), 0))  _
Then
     wksx.Rows(y).ClearContents
    End If
   Next y
  Next x
 End With
End Sub
im blatt 2-11 und 16-17 soll aber nicht die ganze zeileninhalt gelöscht werden sondern nur die zelle in spalte d.

da muss wksx.Rows(y).ClearContents ersetzt werden oder??

gruss


  

Betrifft: AW: Tabellenblätter nach inhalt durchsuchen und lösche von: Christian
Geschrieben am: 05.08.2014 21:40:50

Hallo Christian,

ja, dass hatte ich erst im nachhinein gelesen.

wksx.Cells(y, 4).ClearContents


MfG Christian


  

Betrifft: AW: Tabellenblätter nach inhalt durchsuchen und lösche von: Spenski
Geschrieben am: 05.08.2014 21:45:37

dankeschön


  

Betrifft: AW: Alternative Lösung von: Daniel
Geschrieben am: 05.08.2014 22:19:11

Hallo
da du ja was lernen willst, hier mal eine alternative Lösung mit einem ganz anderen Ansatz.
allerdings dürfen in den Zellen keine Formeln stehen, es müssen feste Werte sein:

Sub test()
Dim i As Long
Dim Zelle As Range
'--- Löschen Blatt 1 Spalte A
With Sheets(1).UsedRange
    With .Columns(.Columns.Count + 1)
        .FormulaR1C1 = "=IF(CountIf(Control!R4C2:R8C2,RC1)>0,0,Row())"
        .Cells(1, 1).Value = 0
        .EntireRow.RemoveDuplicates .Column, xlNo
        .ClearContents
    End With
End With

'--- andere Blätter auswählen
Sheets(2).Select
For i = 2 To 17
    Select Case i
        Case 2 To 11, 16 To 17
            Sheets(i).Select False
        Case Else
    End Select
Next

'--- Inhalte Löschen Spalte D
Columns(4).Select
For Each Zelle In Sheets("Control").Range("B4:B8")
    If Zelle.Value <> "" Then Selection.Replace Zelle.Value, "", xlWhole
Next

Sheets("Control").Select

End Sub
Gruß Daniel


  

Betrifft: AW: Alternative Lösung von: Spenski
Geschrieben am: 05.08.2014 22:55:39

danke daniel.
funktionieren tut es :) , hab aber auch nix anderes erwartet :)

ja ich glaube an dem text kann ich einiges lernen... die hälfte der befehle hab ich bisher noch nie gehört bzw gelesen. werde mich morgen mal ranmachen und alles aufschreiben.


dank euch beiden

gute nacht


  

Betrifft: AW: Alternative Lösung von: Daniel
Geschrieben am: 06.08.2014 00:16:04

vielleicht als Hilfe:
der Code orientiert sich an der Methode, mit der man die Aufgabe am schnellsten von Hand, dh ohne Makrounterstützung lösen würde.

Gruß Daniel


  

Betrifft: AW: Alternative Lösung von: Spenski
Geschrieben am: 06.08.2014 06:20:58

hallo daniel


gruppe bilden und dann ersetzen????

mfg
christian


  

Betrifft: AW: Alternative Lösung von: Daniel
Geschrieben am: 06.08.2014 09:00:34

Ja.

Gruß Daniel


  

Betrifft: AW: Alternative Lösung von: Spenski
Geschrieben am: 06.08.2014 18:38:23

danke


 

Beiträge aus den Excel-Beispielen zum Thema "Tabellenblätter nach inhalt durchsuchen und lösche"