Excel - Een macro om rijen met specifieke waarden te verwijderen

Microsoft Excel is een van de handigste tools om met getallen te spelen. In gevallen waarin een groot aantal rijen of kolommen is betrokken, heeft Excel ook het visuele basisraamwerk dat kan worden gebruikt voor het opnemen of schrijven van aangepaste macro's . Met VBA- macro's kunnen gebruikers het proces automatiseren door een minimale gebruikersinvoer te hebben. Deze macro's kunnen worden aangepast om te werken aan specifieke waarden of rijen. De gebruiker kan ook aanpassen wat het start- en eindbereik moet zijn voor specifieke waarden of rijen. Al deze opties vergroten het gebruik van Excel als een toepassing voor gegevensverwerking .

Kwestie
Oplossing
Let daar op

Kwestie

Eigenlijk wat ik heb is een blad vol met informatie over verschillende afdelingen en wat ik wil doen is elke rij verwijderen BEHALVE de rijen die enkele gespecificeerde waarden bevatten (die ik zou willen ingeven bij het uitvoeren van het script).

Laten we zeggen in de kolom met de naam van de afdeling (in mijn blad met de naam "Avd"), ik zou willen dat het script naar elke cel zoekt die niet de nummers 1, 3, 5, 6 of 21 bevat. en zo verder (ik heb ongeveer 36 verschillende nummers).

Oplossing

Het enige wat u hoeft te doen is de informatie in de kolom markeren en vervolgens de volgende Macro uitvoeren. Er zal een vak zijn dat u zal vragen om te selecteren welke waarde u wilt behouden. Dit is beschikbaar voor maximaal 30.000 rijen.

 Sub DeleteRows () Dim strToDelete As String Dim rngSrc As Range Dim NumRows As Integer Dim ThisRow As Geheel getal Dim ThatRow As Integer Dim ThisCol As Integer Dim J As Integer Dim DelreedRows As Integer strToDelete = InputBox ("Value to Trigger Keep, Jason ??? ? ", " Rijen verwijderen ") Stel rngSrc = ActiveSheet.Range in (ActiveWindow.Selection.Address) NumRows = rngSrc.Rows.Count ThisRow = rngSrc.Row ThatRow = ThisRow + NumRows - 1 ThisCol = rngSrc.Column Dim toprows As Integer Dim bottomRows Als Integer bottomRows = 30000 Voor J = ThisRow to NumRows Stap 1 If Cells (J, ThisCol) = strToDelete Then 'Rows (J) .Selecteer topRows = J Exit For DeletedRows = DeletedRows + 1 End If Next J For J = (topRows + 1) Naar NumRows Stap 1 Als cellen (J, ThisCol) strToDelete dan 'Rijen (J). Selecteer bottomRows = J Exit voor' DeletedRows = DeletedRows + 1 End If Next J If topRows 4 Then ActiveSheet.Range (Cells (4, 1), cellen (topRows - 1, 52)). Selecteer Selection.delete Shift: = xlUp End If ActiveSheet.Range (Cells (bottomRows - topRows + 4, 1), Cells (30000, 52)). Selecteer Selection.delete Shift: = xlUp 'MsgBox' Aantal verwijderde rijen: "& DeletedRows End Sub