Toon posts:

Excel rijen verwijderen gebaseerd op een kolom

Pagina: 1
Acties:

Onderwerpen


Verwijderd

Topicstarter
Beste Tweakers,

Ik heb een probleem met Excel. Ik heb twee werkbladen, het eerste werkblad heeft ongeveer 11.000 regels. Het tweede werkblad heeft er een stuk minder, tussen de 300 en 1000. In beide werkbladen is kolom A gevuld met unieke nummers. De bedoeling is dat de unieke nummers van het tweede werkblad worden gezocht in het eerste werkblad en indien gevonden de gehele betreffende regel in het eerste werkblad wordt verwijderd.

Ik had op het internet een macro gevonden. Misschien dat iemand mij hiermee verder kan helpen. Op dit moment verwijderd de macro alleen het eerste zoek item. Die ook nog eens hard gecodeerd zijn. Ik hoop dat iemand een idee heeft en zin heeft om mij te helpen.

Alvast bedankt!

Morres


Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
 

Sub Delete_Based_on_Criteria()

' This macro will delete an entire row based on the presence of a
'predefined word or set of words.  If that word or set of words is
'found in a cell, in a specified column, the entire row will be 'deleted

Dim X As Long
Dim Z As Long
Dim LastRow As Long
Dim FoundRowToDelete As Boolean
Dim OriginalCalculationMode As Long
Dim RowsToDelete As Range
Dim SearchItems() As String

Dim DataStartRow As Long
Dim SearchColumn As String
Dim SheetName As String

 

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Choose the row you want the search and delete to start on
' Choose the column to search and delete to use for deletion
' Choose the sheet in the workbook you want this macro to be run on

DataStartRow = 1
SearchColumn = "A"
SheetName = "Blad1"

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Enter the terms you want to be used for criteria for deletion
' All terms entered below are CASE SENSITIVE and need to be
'seperated by a comma

SearchItems = Split("INPUT TEXT HERE, INPUT TEXT HERE", ",")

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 

On Error GoTo Whoops
OriginalCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

With Worksheets(SheetName)
LastRow = .Cells(.Rows.Count, SearchColumn).End(xlUp).Row
For X = LastRow To DataStartRow Step -1
FoundRowToDelete = False
For Z = 0 To UBound(SearchItems)
If InStr(.Cells(X, SearchColumn).Value, SearchItems(Z)) Then
FoundRowToDelete = True
Exit For
End If

Next

If FoundRowToDelete Then
If RowsToDelete Is Nothing Then
Set RowsToDelete = .Cells(X, SearchColumn)
Else
Set RowsToDelete = Union(RowsToDelete, .Cells(X, SearchColumn))
End If

If RowsToDelete.Areas.Count > 100 Then
RowsToDelete.EntireRow.Delete
Set RowsToDelete = Nothing
End If
End If

Next

End With
If Not RowsToDelete Is Nothing Then
RowsToDelete.EntireRow.Delete
End If

Whoops:
Application.Calculation = OriginalCalculationMode
Application.ScreenUpdating = True

 
End Sub 

  • pedorus
  • Registratie: Januari 2008
  • Niet online
Die macro lijkt me hier totaal onnuttig.. ;)

Volgens mij kun je het beste een hulpkolommetje aanmaken waarbij je kijkt of er een match is (=match(waarde,zoekkolom,0)). Vervolgens kun je filteren op die kolom en selecteer je de te verwijderen rijen. Verwijder die en klaar ben je (nadat je het filter hebt uitgezet).

Vitamine D tekorten in Nederland | Dodelijk coronaforum gesloten


Acties:
  • 0 Henk 'm!

Verwijderd

Topicstarter
Hoi,

Ik heb het even geprobeerd met het filteren van de kolom. Het is inderdaad een stukje eenvoudiger op deze manier! Bedankt voor de tip.