Excel Makro sucht nach Variable und löscht Datensatz!?

Hallo liebe Community,

ich bräuchte eure schnelle Hilfe wieder einmal. Ich habe ein schönes Makro, das an sich super funktioniert. Es sucht nach einer Variable und löscht entsprechend alle Zeilen, wenn man es auslöst.

Beispiel es soll B1 suchen und wenn vorhanden, alle 4 Datenreihen in der Tabelle löschen. Leider habe ich das Problem, an dem ich gerade verzweifle, dass Excel nicht nur B1 löscht, sondern wenn vorhanden, auch B10, B11, B12, B13, B14, B15, B16, B17, B18 und B19

An welcher Stelle des Makros kann ich es ändern, dass Excel wirklich nur das sucht und löscht, was auch tatsächlich gesucht wird.

Mein Makro:

Sub B1_weg()
Dim lngZ As Long
For lngZ = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
  If InStr(Cells(lngZ, 4), "B1") > 0 Then
    Cells(lngZ, 1).EntireRow.Delete
  End If
Next
End Sub

Vielen Dank im Voraus!

2 Antworten

Suboptimierer

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

12.04.2022, 08:23

Wozu suchst du denn mit Instr? Reicht nicht if Cells(lngZ, 4) = "B1"?

Oder steht sehr wohl weiterer Text in der Zelle. Dann brauchst du ein, zwei Zeilen mehr, geht aber trotzdem

int = InStr(Cells(lngZ, 4), "B1")
if (int > 0) and (not IsNumeric(Mid(Cells(lngZ, 4), int+3, 1))) Then
  ...

(ungetestet)

Du prüfst also, ob das Zeichen hinter B1 eine Ziffer ist.

Pambott

Fragesteller

12.04.2022, 08:30

In der Zelle, wo B1 steht, steht nichts Weiteres. Es ist aber in der Spalte D. In Spalte A, B und C sind andere Angaben, die nicht gesucht werden, sondern einfach mitgelöscht werden.

Pambott

Fragesteller

12.04.2022, 08:35

Dein Code funktioniert leider nicht :(

Suboptimierer

12.04.2022, 08:47

@Pambott

Schade

IchMalWiederXY

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel, VBA

12.04.2022, 13:02

Den ganzen Inhalt vergleichen:
If Cells(lngZ, 4).Value = "B1" Then

Hi,

wie schaffe ich es, dass der Filter nicht mit "TEST", sondern mit der Variable gefüllt wird? (Variable ist einfach nur "Z")

Sub Schaltfläche6_Klicken()
'
' Schaltfläche6_Klicken Makro
'

'
Dim Variable As Variant


Variable = Range("B1").Value

   ActiveSheet.ListObjects("Tabelle1").Range.AutoFilter Field:=2, Criteria1:= _
       "TEST"
End Sub

...zur Frage

Excel: Schiebepuzzle programmieren - Laufzeitfehler 424?

Liebe Community, ich habe versucht eine Schiebepuzzle aus Zahlen in Excel zu programmieren. Den Text seht ihr unten. Jedoch sobald ich auf Ausführen (Wiedergabe-Button) drücke, kommt folgender Fehler:

Laufzeitfehler '424':
Objekt erforderlich

Könnt ihr mir bitte helfen den Fehler zu finden?

Vielen Dank im Vorraus
Lamio13

Dim xpos As Integer   
Dim ypos As Integer  
Dim AlleKnoepfe(1 To 15) As CommandButton

Private Sub UserForm_Initialize()
Set AlleKnoepfe(1) = CommandButton1
Set AlleKnoepfe(2) = CommandButton2
...  
Set AlleKnoepfe(14) = CommandButton14
Set AlleKnoepfe(15) = CommandButton15
End Sub

Sub FindMich(ich As String)
    Dim ii As Integer
    Dim jj As Integer

    For jj = 1 To 4
                 For ii = 1 To 4
                      If (Cells(jj, ii) = ich) Then
                         xpos = ii
                          ypos = jj
                          ii = 5
                          jj = 5
                      End If
                 Next ii
    Next jj
End Sub
Private Sub KannMichBewegen()

    'untersuche, ob rechts frei ist
    If (Cells(ypos, xpos + 1) = "") Then
        Cells(ypos, xpos + 1) = Cells(ypos, xpos)
        Cells(ypos, xpos + 1) = ""
    End If

End Sub

Sub VerschiebMich(SchubladenNummer As Integer)
    'untersuche, ob rechts frei ist
    If (xpos < 4) Then
            If (Cells(ypos, xpos + 1) = "") Then
                Cells(ypos, xpos + 1) = Cells(ypos, xpos)
                Cells(ypos, xpos) = ""
                AlleKnoepfe(SchubladenNummer).Left = AlleKnoepfe(SchubladenNummer).Left + AlleKnoepfe(SchubladenNummer).Width
            End If
    End If

    'untersuche, ob unten frei ist
    If (ypos < 4) Then
            If (Cells(ypos + 1, xpos) = "") Then
                Cells(ypos + 1, xpos) = Cells(ypos, xpos)
                Cells(ypos, xpos) = ""
                AlleKnoepfe(SchubladenNummer).Top = AlleKnoepfe(SchubladenNumemr).Top + AlleKnoepfe(SchubladenNummer).Height
            End If
    End If

    'untersuche, ob links frei ist
    If (xpos > 1) Then
            If (Cells(ypos, xpos - 1) = "") Then
                Cells(ypos, xpos - 1) = Cells(ypos, xpos)
                Cells(ypos, xpos) = ""
                AlleKnoepfe(SchubladenNummer).Left = AlleKnoepfe(SchubladenNummer).Left + AlleKnoepfe(SchubladenNummer).Width
            End If
    End If

    'untersuche, ob oben frei ist
    If (ypos > 1) Then
            If (Cells(ypos - 1, xpos) = "") Then
                Cells(ypos - 1, xpos) = Cells(ypos, xpos)
                Cells(ypos, xpos) = ""
                AlleKnoepfe(SchubladenNummer).Top = AlleKnoepfe(SchubladenNumemr).Top + AlleKnoepfe(SchubladenNummer).Height
            End If
    End If

End Sub

Private Sub CommandButton1_Click()
    FindMich (CommandButton1.Caption)
    VerschiebMich (1)
    End Sub
...

...zur Frage

Excel: Verbessertes Logging mit VBA Makro?

Hallo Zusammen

ich verwende im Moment ein kurzes Makro, um Änderungen in einem Tabellenblatt zu loggen.

Es registriert aber nur einzelne Änderungen, nicht multi-selektion oder Löschen von Spalten. Kann ich das mit separaten Privaten Subs übernehmen?

Und kann ich aufnehmen, was die Target- und "PreVal"-Adresse war (Offset 4+5)

Code:

Dim PreVal
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
PreVal = Target.Value
 
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  
    On Error GoTo 0
    
    If Target.Value <> PreVal Then
        With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
            .Offset(1, 0) = Now
            .Offset(1, 1) = PreVal
            .Offset(1, 2) = Target.Value
            .Offset(1, 3) = Environ("Username")
        End With
    End If
 
End Sub

...zur Frage

Excel Makro .AutoFilter variable Range?

Hallo,

ich habe ein simples Excel Makro aufgenommen, in der ich eine Tabelle nach bestimmten Kriterien Filtern muss. Die Tabelle kann variabel lang sein.

Durch die Funktion "Makro aufzeichnen" habe ich folgendes:

"ActiveSheet.Range("$A$1:$S$249").AutoFilter Field:=15, Criteria1:="0""

Wie kann ich die Zeilenlänge durch eine Variable ersetzen? Die Länge der Tabelle würde ich einfach durch:

X = (Range("A2").End(xlDown).Row)

ermitteln.

Bitte um Entschuldigung für die Frage, ich schreibe nur sehr selten Makros.

Vielen Dank für eure Hilfe. :)

...zur Frage

Wie kann ich bei Excel einen Button erstellen der abspeichert?

Hallo,

Ich würde gerne bei Excel einen Button erstellen, der die Excel mappe auf dem Desktop abspeichert. Der Name der Datei soll in Zeile A1 stehen.

Den Button habe ich bereits erstellt. Ich scheitere noch bei dem Makro, weil ich keine ahnung davon habe. Ich habe etwas im Internet gefunden, was meinen Vorstellungen nahe kommt. Ich habe versucht es anzupassen, aber irgendwie klappt das alles nicht.

Sub Schaltfläche1_Klicken()
Dim lw_pfad As String
lw_pfad = ActiveSheet.Range("A1").Value
lw_pfad = InputBox("Geben Sie hier das Laufwerk und den Pfad an, wo die Datei gespeichert werden soll." & Chr(13) & Chr(13) & "(Ihre Eingabe wird in A1 als neuer Default-Wert gespeichert.)", "Datei speichern unter...", lw_pfad)
If lw_pfad = "" Then
  MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
  Exit Sub
Else
  If Right(lw_pfad, 1) <> "\" Then lw_pfad = lw_pfad & "\"
  ActiveSheet.Range("A1").Value = lw_pfad
Rem MsgBox lw_pfad
ActiveWorkbook.SaveAs lw_pfad & ActiveSheet.Range("B2").Value & ActiveSheet.Range("C4").Value & ".xls"
MsgBox "Die Datei wurde unter " & lw_pfad & ActiveSheet.Range("B2").Value & ActiveSheet.Range("C4").Value & ".xls gespeichert.", , "OK"
End If
End Sub

Das ist, was ich bis jetzt habe.

Vielen Dank für die Hilfe im Voraus!

...zur Frage

Excel VBA: Sverweis Formel - Makro einfügen!

Hi zusammen. Habe mir heute mein erstes Userform gebastelt (Google sei Dank...). Mein UF macht simpel nichts anderes, als Einträge aus der EIngabemaske in eine Tabelle zu füllen.

Dim emptyRow As Long

'Ermitteln der ersten leeren Zeile
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

'Wohin werden die eingegebenen Datein eingefüllt?
Cells(emptyRow, 1).Value = ComboBox1.Value
Cells(emptyRow, 5).Value = TextBox1.Value
Cells(emptyRow, 2).Value = TextBox2.Value
Cells(emptyRow, 3).Value = TextBox3.Value
Cells(emptyRow, 7).Value = TextBox4.Value

If OptionButton1.Value = True Then
    Cells(emptyRow, 6).Value = "1. Halbjahr"
End If

If OptionButton2.Value = True Then
    Cells(emptyRow, 6).Value = "2. Halbjahr"
End If


Me.Label7 = "Speichern erfolgreich!"

End Sub

Ich muss auch sagen, es funktioniert prächtig. Die Einträge werden alle korrekt erstellt etc. Nur habe ich in Spalte "H" meiner Tabelle, wo die Daten eingefügt werden, eine Spalte für SVerweis. Diese Formel soll jedesmal, wenn ein neuer Eintrag gespeichert wird, angefügt werden. Wenn ich von anfang an alle Formeln runterziehe bis ans Ende der Tabelle braucht Excel 2Minuten zum das Dokument zu öffnen... Formel lautet: =SVERWEIS($A2;'Tabelle1'!$A$1:$C$31;2;FALSCH) Wobei der Bezug A2 natürlich mit jeder Zeile anders ist (A2, A3, A4 etc.) Wenn ich die Formel "aufzeichne", erscheint folgendes, womit ich absolut nix anfangen kann.

Sub SVerweis_HC()
'
' SVerweis_HC Makro
'

'
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC1,'Tabelle1'!R[-1317]C[-7]:R[-1289]C[-6],2,FALSE)"
    Range("H1319").Select
End Sub

Kann hier wer helfen?

...zur Frage

Makro zum Zusammenfassen von Spalten

Hallo alle zusammen,

ich hab ein kleines Problem mit einem Makro, welches ich mir mit Hilfe diverser Quellen versucht habe auf meinen Fall zusammenzuschustern. Folgendermaßen kann man sich die Grundsituation vorstellen:

Ich habe in den Spalten D Und E ca 70 Zeilen mit Einträgen. Bis auf die Zellen 11 - 14 Ist die Spalte E leer. Also wollte ich ein Makro benutzen, welches die Spalte D wenn D und/oder E leer sind mit E zusammenfasst und sonst nicht.

Das soll dann auch für die Spalten F,G und H,I und immer soweiter klappen. Wer könnte mir Helfen und zeigen wo mein Fehler liegt denn bisher funktioniert das Makro nicht ganz so wie ich mir das vorgestellt habe.

Sub Formatierung()

Dim Zeile As Integer Dim Spalte As Integer

For Spalte = 4 To 256 Step 2
For Zeile = 1 To 100

If ((Not (IsEmpty(Cells(Spalte, Zeile)))) = True And IsEmpty(Cells(Spalte + 1, Zeile)) = True) Then
Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte + 1)).Merge
End If

If IsEmpty(Cells(Spalte, Zeile)) = True And IsEmpty(Cells(Spalte + 1, Zeile)) = True Then
Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte + 1)).Merge
End If

Next Zeile

Next Spalte

End Sub

So sieht das bisher aus. Für jede Hilfe vorab schonmal besten Dank

...zur Frage

VBA MSG BOX Titel nur aufzählen wenn Spalte "L" bestimmter Text?

Hallo zusammen,

ich komme bei diesem Code nicht weiter. Die Msgbox soll nur die Zeilen auflisten wenn ihn Spalte "L" der Text "offen" vorkommt. Kann mir dabei jemand bitte behilflich sein?

Private Sub Workbook_Open()

Dim rDatWartung

Dim sMsgBaldFaellig As String

Dim sMsgUeberFaellig As String

sMsgBaldFaellig = ""

sMsgUeberFaellig = ""

lz = Cells(Rows.Count, 5).End(xlUp).Row

For Each rDatWartung In Range("D30:D600")

If rDatWartung.Value <> "" Then

If rDatWartung.Value <= Date + 7 Then

sMsgUeberFaellig = sMsgUeberFaellig & Cells(rDatWartung.Row, 4) & " " & vbCrLf & Cells(rDatWartung.Row, 6)

Else

If rDatWartung.Value <= Date + 14 Then _

sMsgBaldFaellig = sMsgBaldFaellig & Cells(rDatWartung.Row, 4) & " " & Cells(rDatWartung.Row, 4) & vbCrLf

End If

If sMsgUeberFaellig & sMsgBaldFaellig <> "" Then

MsgBox "Überfällig" & vbCrLf & " " & sMsgUeberFaellig

End If

End Sub

Herzlichen Dank, und einen schönen Abend

...zur Frage

Ich benötige einen Makro, um ausgewählte Filter beim Schliessen zurück zu setzen. Aber mit dem Blattschutz funktioniert das nicht mehr. Kann mir jemand helfen?

Ich habe bisher diesen Makro benutzt:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim wksSheet As Worksheet
    For Each wksSheet In ThisWorkbook.Worksheets
        With wksSheet
            If .AutoFilterMode Then
                If .FilterMode Then
                    .ShowAllData
                End If
            End If
        End With
    Next wksSheet
    ThisWorkbook.Save
End Sub

...zur Frage

MS Excel Makro Pausieren ohne Excel komplett zu pausieren?

Hi, Ich arbeite an einer art "Schiffe Versenken" für MS Excel und arbeite grade daran, dass man auf Zeit Spielen kann. dafür brauche ich logischerweise nen Timer, der die eingestellte Zeit Herunterzählt und das Spiel Beendet. Das war kein Großes Problem für mich, bis auf eine Sache: Das Makro funktioniert zwar, aber ich habe keinen Befehl gefunden der es zulässt, dass man, während der Timer läuft, noch das Spielfeld benutzen kann, da auch Excel pausiert wird und keine Änderung an den Zellen zulässt. Kennt einer von euch einen Befehl, bei dem nur das Makro angehalten wird und nicht das komplette Programm? Mein Makro sieht bis jetzt so aus:

Sub Schaltfläche1_Klicken()

Dim SE As Integer

Dim MN As Integer

Dim I As Integer

I = 0

Do While I = 0

I = 0

SE = Sheets("Eigene Flotte").Range("O26").Value

MN = Sheets("Eigene Flotte").Range("N26").Value

If SE > 0 Then

SE = SE - 1

Sheets("Eigene Flotte").Range("O26").Value = SE

Else

If MN > 0 Then

MN = MN - 1

SE = 59

(hier soll der Befehl zum Pausieren hin)

Sheets("Eigene Flotte").Range("O28").Value = SE

Sheets("Eigene Flotte").Range("N26").Value = MN

Else

Range("A1:L30").Value = ""

I = 1

End If

Loop

End Sub

...zur Frage

Excel VBA: Text aus Inputbox in Zelle ergänzen (nicht überschreiben)

Hallo ihr Lieben Excel-Profis,

ich hab ein kleines Excel-File, welches ich täglich öffne und wo ich zum aktuellen Datum einen Eintrag mache). Das passiert über eine Inputbox. Wenn ich aber das Excel ein zweites Mal öffne und einen neuen Text eingeben, dann überschreibt es mir den alten Text. Ich würde jetzt gerne mein Makro so umbauen, dass ich den Text in die Zelle dazuschreibe. Sub eintragen()

Dim x As Range Dim symptom As String

symptom = InputBox("heutige Symptome:", "In Spalte D", "") If symptom = "" Then Exit Sub With Sheets("Kalender") Set x = .Range("D:D").Find(Date) If x Is Nothing Then MsgBox "Der " & Date & " wurde nicht gefunden!" Else .Cells(x.Row, 6) = symptom End If End With End Sub

Bitte um Unterstützung!

Danke! :-)

...zur Frage

Beim ändern einer bestimmten Zelle Makro erneut ausführen?

Hallo,

ich habe folgendes Anliegen: Ich möchte in Excel mit VBA etwas machen. Hier einmal der Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("j10")) Is Nothing Then
    Select Case Range("j10").Value
        Case "manuell"
            Range("s7:u7").ClearContents
        Case "Anfang & Ende"
            Range("s7").Value = Worksheets("PEPStauchung").Range("d2").Value
    End Select
End If
End Sub

Ich möchte, dass, wenn ich in Zelle S6 einen Wert ändere, das ganze erneut durchgeführt wird.

Wie binde ich das ein? Vielen Dank!!!

Syrena

...zur Frage

VBA Ausgewählte Zeilen kopieren und in anderer Tabelle einfügen (mit Variablen)?

Hallo Zusammen,

Ich hab ein Problem. Ich würde gern durch das schreiben einer 1 hinter meiner Materialsammlung per Knopfdruck alle gewählten Zeilen in eine Zusammengestellte Tabelle einfügen.

Die Materialsammlung bei der ich auswähle ist in Tabelle zwei und wird dann per Knopfdruck abgefragt. Die markierten sollen dann in Tabelle 1 in eine Tabelle eingefügt werden.

Da ich aber mit Variablen Arbeite ist das schwieriger als gedacht

Hier mein code zum verdeutlichen

Private Sub CommandButton1_Click()

Dim strBereich As Range Dim x As Integer

For x = 3 To 60 If Worksheets(2).Cells(x, 10) = "1" Then

Worksheets(1).Range(Cells(x, 2), Cells(x, 9))=Worksheets(2).Range(Cells(x, 1), Cells(x, 8))

End If Next x

End Sub

funktioniert leider aber nicht.

Bitte im Hilfe

...zur Frage

VBA Code Erklärung

Guten Abend zusammen. Könnte mir jemand weiterhelfen bei diesem Code. Was macht er genau in Excel? Also Die einzelnen Schritte die er durchläuft,.

Option Explicit

Public Sub Double_Red()
Dim lngZeile As Long
Dim lngZeilenSprung As Long
Dim strSuchwert As String

lngZeile = Cells(Rows.Count, 4).End(xlUp).Row

  For lngZeilenSprung = lngZeile To 1 Step -1
    strSuchwert = Cells(lngZeilenSprung, 4).Value
      If Application.WorksheetFunction.CountIf(Range(Cells(1, 4), Cells(lngZeile, 4)), strSuchwert) <> 1 Then
        Cells(lngZeilenSprung, 4).Interior.ColorIndex = 3
      End If
  Next lngZeilenSprung

End Sub

...zur Frage

Was möchtest Du wissen?

Deine Frage stellen