• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Zoekvolgorde

Status
Niet open voor verdere reacties.
M

Mosselman

Gebruiker
Lid geworden
5 aug 2007
Berichten
61
L.s,

Wie kan mij helpen?
------------------------------
Ik heb hieronder 3 dezelfde codes staan, welke ik in één VBA plaats.
Vanuit range A5:EZ36 wordt van Rechts naar Links in een tabel gezocht naar de tekst die genoemd wordt na WHAT:=.
Bij de eerste twee codes gaat dit goed. Vanaf code 3 start het zoeken in eens van Rechts naar Links. Hoe kan dit? De zoekvolgorde bepaalt namelijk de plaatsing van de gevonden tekst in een andere sheet.

Alvast bedankt voor jullie adviezen.
-----------------------------------


'Code 1
'MM-Alexandrium
Sheets("Totaal reparaties").Select
Range("A5:EZ36").Select
Selection.Replace What:="", Replacement:="#", LookAt:=xlPart, _
Searchorder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
If Range("C51") = "X" Then
Dim LastRow As Long
Dim C As Object
Dim Firstaddress As String
LastRow = Range("AZ35").End(xlUp).Row
With Sheets("Totaal reparaties").Range("A5:EZ36")
Set C = .Find(What:="MM - Alexandrium", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlByRows)
If C Is Nothing Then GoTo EINDE
Firstaddress = C.Address
Do
C.Offset(0, 0).Copy Destination:=Sheets("Vergelijk totaal rep").Range("C100").End(xlUp).Offset(1, 0)
C.Offset(0, 1).Copy Destination:=Sheets("Vergelijk totaal rep").Range("D100").End(xlUp).Offset(1, 0)
C.Offset(0, -1).Copy Destination:=Sheets("Vergelijk totaal rep").Range("B100").End(xlUp).Offset(1, 0)
Worksheets("Vergelijk totaal rep").Range("A1:IV65536").Columns.AutoFit
Set C = .FindNext(C)
Loop While C.Address <> Firstaddress
End With
End If

'Code 2
'MM-Alkmaar
Sheets("Totaal reparaties").Select
Range("A5:EZ36").Select
Selection.Replace What:="", Replacement:="#", LookAt:=xlPart, _
Searchorder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
If Range("C52") = "X" Then
LastRow = Range("AZ35").End(xlUp).Row
With Sheets("Totaal reparaties").Range("A5:EZ36")
Set C = .Find(What:="MM - Alkmaar", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlByRows)
If C Is Nothing Then GoTo EINDE
Firstaddress = C.Address
Do
C.Offset(0, 0).Copy Destination:=Sheets("Vergelijk totaal rep").Range("G100").End(xlUp).Offset(1, 0)
C.Offset(0, 1).Copy Destination:=Sheets("Vergelijk totaal rep").Range("H100").End(xlUp).Offset(1, 0)
C.Offset(0, -1).Copy Destination:=Sheets("Vergelijk totaal rep").Range("F100").End(xlUp).Offset(1, 0)
Worksheets("Vergelijk totaal rep").Range("A1:IV65536").Columns.AutoFit
Set C = .FindNext(C)
Loop While C.Address <> Firstaddress
End With
End If

'Code 3
'MM-Almere
Sheets("Totaal reparaties").Select
Range("A5:EZ36").Select
Selection.Replace What:="", Replacement:="#", LookAt:=xlPart, _
Searchorder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
If Range("C53") = "X" Then
LastRow = Range("EZ36").End(xlUp).Row
With Sheets("Totaal reparaties").Range("A5:EZ36")
Set C = .Find(What:="MM - Almere", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlByRows)
If C Is Nothing Then GoTo EINDE
Firstaddress = C.Address
Do
C.Offset(0, 0).Copy Destination:=Sheets("Vergelijk totaal rep").Range("K100").End(xlUp).Offset(1, 0)
C.Offset(0, 1).Copy Destination:=Sheets("Vergelijk totaal rep").Range("L100").End(xlUp).Offset(1, 0)
C.Offset(0, -1).Copy Destination:=Sheets("Vergelijk totaal rep").Range("J100").End(xlUp).Offset(1, 0)
Worksheets("Vergelijk totaal rep").Range("A1:IV65536").Columns.AutoFit
Set C = .FindNext(C)
Loop While C.Address <> Firstaddress
End With
End If

'Code 4
'MM-Alphen
Sheets("Totaal reparaties").Select
Range("A5:EZ36").Select
Selection.Replace What:="", Replacement:="#", LookAt:=xlPart, _
Searchorder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
If Range("C54") = "X" Then
LastRow = Range("AZ35").End(xlUp).Row
With Sheets("Totaal reparaties").Range("A5:EZ36")
Set C = .Find(What:="MM - Alphen ad Rijn", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlByRows)
If C Is Nothing Then GoTo EINDE
Firstaddress = C.Address
Do
C.Offset(0, 0).Copy Destination:=Sheets("Vergelijk totaal rep").Range("O100").End(xlUp).Offset(1, 0)
C.Offset(0, 1).Copy Destination:=Sheets("Vergelijk totaal rep").Range("P100").End(xlUp).Offset(1, 0)
C.Offset(0, -1).Copy Destination:=Sheets("Vergelijk totaal rep").Range("N100").End(xlUp).Offset(1, 0)
Worksheets("Vergelijk totaal rep").Range("A1:IV65536").Columns.AutoFit
Set C = .FindNext(C)
Loop While C.Address <> Firstaddress
End With
End If
 
Mosselman,
Je moet de volgende keer je code tussen de codetag zetten.
Selecteer je code en klik boven aan de menubalk op #
 
Deze macro (tussen code-tags #)
Code: 
Sub simpel()
  on error resume next
  If [Totaal reparaties!C51]="X" then [Totaal reparaties!A5:EZ36].find("MM - Alexandrium",,xlvalues,xlwhole).offset(,-1).resize(,3).copy Sheets("Vergelijk totaal rep").cells(rows.count,3).End(xlUp).Offset(1)
End Sub
Doet hetzelfde als:

Code: 
'Code 1
'MM-Alexandrium
Sheets("Totaal reparaties").Select
Range("A5:EZ36").Select
Selection.Replace What:="", Replacement:="#", LookAt:=xlPart, _
Searchorder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
If Range("C51") = "X" Then
Dim LastRow As Long
Dim C As Object
Dim Firstaddress As String
LastRow = Range("AZ35").End(xlUp).Row
With Sheets("Totaal reparaties").Range("A5:EZ36")
Set C = .Find(What:="MM - Alexandrium", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlByRows)
If C Is Nothing Then GoTo EINDE
Firstaddress = C.Address
Do
C.Offset(0, 0).Copy Destination:=Sheets("Vergelijk totaal rep").Range("C100").End(xlUp).Offset(1, 0)
C.Offset(0, 1).Copy Destination:=Sheets("Vergelijk totaal rep").Range("D100").End(xlUp).Offset(1, 0)
C.Offset(0, -1).Copy Destination:=Sheets("Vergelijk totaal rep").Range("B100").End(xlUp).Offset(1, 0)
Worksheets("Vergelijk totaal rep").Range("A1:IV65536").Columns.AutoFit
Set C = .FindNext(C)
Loop While C.Address <> Firstaddress
End With
End If

Wanneer je mijn macro met 2 regels uitbreidt kan die de volledige (4 macro's), door jou geplaatste code vervangen.
Maar er zijn voor dit soort akties ook ingebouwde faciliteiten in Excel: autofilter, uitgebreid filter.

PS. en een beetje meer gevoel voor humor kan ook geen kwaad.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan