Gegevens wegschrijven dmv lijst.

danny147 · 4 sep 2012

Beste HSV,

Sorry voor de verwarring :d

De datum in kolom H krijg ik door het bestandje met de code te laten lopen.
Zoals je ziet is deze datum niet goed voor mij om op te filteren.

Daarom heb ik een formule geplaatst in kolom M3, deze naar beneden gesleept.
Daarna kopiëren en speciaal plakken in kolom I, op waarden en OK.

Dan bekom ik een datum waarop ik wel kan filteren in kolom I met datumfilter.

Indien je code kan maken, dan enkel toepassen op kolom I voor Blad1 tem Blad33

Groetjes Danny. :thumb:

HSV · 4 sep 2012

Ach zo,..... zo is het duidelijk.

Code:

Sub hsv()
Dim cl As Range
 For Each cl In Range("I3:I" & Cells(Rows.Count, 9).End(xlUp).Row)
  If WorksheetFunction.And(cl > 0, InStr(cl, "/") > 0) Then
   Cells(cl.Row, 13) = DateValue(Format(cl, "dd-mm-yyyy"))
 Else
     Cells(cl.Row, 13).Value = cl
    End If
  Next cl
End Sub

Maak van de 13 in de code later even 9, als het goed bevonden is.

HSV · 4 sep 2012

Samen met de vorige code maakt dit:

Code:

Sub hsv()
Dim ws As Long, Lrow As Long, i As Long, c As Range
Application.ScreenUpdating = False
 For ws = 2 To Sheets.Count
   With Sheets(ws)
    Lrow = .Cells(Rows.Count, 3).End(xlUp).Row
 For i = Lrow To 2 Step -1
    Set c = Blad1.Columns(40 + ws).Find(.Cells(i, 3), , xlValues, xlWhole)
 If c Is Nothing Then .Cells(i, 1).EntireRow.Delete
    Next i
Dim cl As Range
 For Each cl In .Range("I2:I" & .Cells(Rows.Count, 9).End(xlUp).Row)
  If WorksheetFunction.And(cl > 0, InStr(cl, "/") > 0) Then
   cl = DateValue(cl)
   cl.NumberFormat = "dd-mm-yyyy"
 Else
     cl = cl
    End If
  Next cl
End With
  Next ws
End Sub

danny147 · 4 sep 2012

Beste HSV,

Is dit voor 1 tabblad of voor de gevraagde 33 tabladen ?

Groetjes Danny. :thumb:

HSV · 4 sep 2012

Als het samen moet met die van kolom AP & AQ enz. t/m 33, dan zie mijn vorig schrijven.
Of haal ik de boel nu door elkaar.

danny147 · 5 sep 2012

Beste HSV,

In volgende code mag rij 2 niet verwijderd worden.

Code:

Sub hsv_3()
Dim ws As Long, Lrow As Long, i As Long, c As Range
Application.ScreenUpdating = False
 For ws = 17 To 20 'Sheets.Count
   With Sheets(ws)
    Lrow = .Cells(Rows.Count, 3).End(xlUp).Row
 For i = Lrow To 2 Step -1
    Set c = Blad1.Columns(25 + ws).Find(.Cells(i, 3), , xlValues, xlWhole)
 If c Is Nothing Then .Cells(i, 1).EntireRow.Delete
    Next i
End With
  Next ws
End Sub

Volgende code werkt enkel in het openstaand blad en zou dit graag gewild hebben voor tabblad 1 tem tabblad 33.

Code:

Sub hsv_2()
Dim cl As Range
 For Each cl In Range("I3:I" & Cells(Rows.Count, 9).End(xlUp).Row)
  If WorksheetFunction.And(cl > 0, InStr(cl, "/") > 0) Then
   Cells(cl.Row, 9) = DateValue(Format(cl, "dd-mm-yyyy"))
 Else
     Cells(cl.Row, 9).Value = cl
    End If
  Next cl
End Sub

Groetjes Danny. :thumb:

HSV · 5 sep 2012

Om rij twee niet te verwijderen, maak je van de 2 een 3.

Code:

For i = Lrow To 3 Step -1

In het eerste voorbeeld van je staat het voor tabblad 17 t/m 20.
Dit kun je toch zo aanpassen voor 1 t/m 33 lijkt me.

danny147 · 5 sep 2012

Beste HSV,

Moet het dan zoiets worden ?
2 X For achter elkaar ?

Code:

Sub hsv_2()
Dim cl As Range
[COLOR="#FF0000"]For ws = 1 To 33[/COLOR] 
For Each cl In Range("I3:I" & Cells(Rows.Count, 9).End(xlUp).Row)
  If WorksheetFunction.And(cl > 0, InStr(cl, "/") > 0) Then
   Cells(cl.Row, 9) = DateValue(Format(cl, "dd-mm-yyyy"))
 Else
     Cells(cl.Row, 9).Value = cl
    End If
  Next cl
End Sub

Groetjes Danny. :thumb:

HSV · 5 sep 2012

Hoi Danny,

Zo dan.

Code:

Sub hsv_2()
Dim ws As Long, cl As Range
For ws = 1 To 33
   With Sheets(ws)
For Each cl In .Range("I3:I" & .Cells(Rows.Count, 9).End(xlUp).Row)
  If WorksheetFunction.And(cl > 0, InStr(cl, "/") > 0) Then
        cl = DateValue(cl)
        cl.NumberFormat = "dd-mm-yyyy"
     Else
        cl = cl
    End If
   Next cl
  End With
 Next ws
End Sub

danny147 · 5 sep 2012

Beste HSV

Thuis getest en in orde bevonden.

Morgen nog eens testen op het werk om nadien de topic af te sluiten.
Na 170 posts is het welletjes geweest denk ik :d

Groetjes Danny. :thumb:

HSV · 5 sep 2012

Veel succes er mee Danny. :thumb:

Zet het morgen maar op 172 en afsluiten, anders gaan we gewoon door.
Je code is inmiddels zo groot geworden en daardoor moeilijk te onderhouden bij wijzigingen.
We zien wel waar het schip strand.

danny147 · 7 sep 2012

Beste HSV,

Getest op het werk en alles verloopt zoals het hoort Harry :thumb:

Zie hieronder de volledige code die het nu geworden is.
Heb ze een beetje opgekuist voor lees - en zichtbaarheid.

Bedankt voor alles. :thumb::d

Code:

Sub Uitvoeren_naar_AA_Kranen_origineel()
Application.ScreenUpdating = False
Application.SheetsInNewWorkbook = 34
Workbooks.Add

ActiveWorkbook.SaveAs "H:\Mijn documenten\LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xlsx"

Dim bestandopen
 bestandopen = Dir("H:\Mijn documenten\Danny\*")
    Do Until bestandopen = ""
      If bestandopen = "" Then Exit Do
        Workbooks.Open "H:\Mijn documenten\Danny\" & bestandopen
      With ActiveWorkbook.Sheets(1)
       .Range("B1:k" & .Cells.SpecialCells(xlLastCell).Row).Copy _
       Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xlsx").Sheets(1).Cells(Rows.Count, 2).End(xlUp).Offset(1)
      End With
        Application.DisplayAlerts = False
        Workbooks(bestandopen).Close True
      bestandopen = Dir
Loop
           
    With Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xlsx")
     With .Sheets(1)
        On Error Resume Next
            .Range("K2:K13000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
            .Range("B3:K13000").Sort Key1:=Range("C2"), Order1:=xlAscending
              Workbooks.Open "H:\Mijn documenten\Lijst_LK's.xls"
                Workbooks("Lijst_LK's.xls").Sheets("Blad1").Range("AA1").CurrentRegion.Copy .Range("AA1")
           For i = 1 To .UsedRange.Rows.Count 'rijen
                    For j = 1 To 11 'kolommen
                    .Cells(i, j) = RTrim(.Cells(i, j))
                    .Cells(i, 9) = Split(.Cells(i, 9))
                    .Cells(i, 8) = Split(.Cells(i, 8))
                Next j
                Next i
            For Each cdt In .Columns(9).SpecialCells(2)
                cdt.Value = Split(cdt.Value)
                If cdt Like "##-##-####" Or cdt Like "##-#-####" Or cdt Like "#-#-####" Or cdt Like "#-##-####" Then
                cdt.Value = DateValue(cdt.NumberFormat)
                cdt.NumberFormat = "dd-mm-yyyy"
                End If
                Next cdt
               .Range("B2:K" & .Cells.SpecialCells(11).Row).AutoFormat Format:=xlRangeAutoFormatClassic1
               .Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
               .Columns.AutoFit
            End With
      Workbooks("Lijst_LK's.xls").Close True
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True

    Dim cl      As Range
    Dim c       As Variant
    Dim Rij     As Long
    
Application.ScreenUpdating = False
 sq = "Roepnaam" & "|" & "Machine" & "|" & "Omschrijving" & "|" & "Werkorder" & "|" & "Status" & "|" & "OnderhoudsType" & "|" _
 & "BeginTijdstipGepland" & "|" & "EindTijdstipGepland" & "|" & "CapacitaitsgroepID" & "|" & "Werkvoorbereider" & "|"
           
With Sheets("Blad10")
  .Range("A2") = "718.MEC"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 9, Criteria1:="718.1", Operator:=xlOr, Criteria2:="718.2"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad10").Range("A3")
              End With
       .AutoFilter 9, Criteria1:="718.B1", Operator:=xlOr, Criteria2:="718.B2"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad10").Range("C1500").End(xlUp).Offset(0, -2)
              End With
       .AutoFilter 9, Criteria1:="718.ME"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad10").Range("C2000").End(xlUp).Offset(0, -2)
                Sheets("Blad10").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
          End With
          End With
          
With Sheets("Blad11")
  .Range("A2") = "718.ELE"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 9, Criteria1:="718.AB", Operator:=xlOr, Criteria2:="718.CD"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad11").Range("A3")
              End With
       .AutoFilter 9, Criteria1:="718.EL"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad11").Range("C1000").End(xlUp).Offset(0, -2)
                Sheets("Blad11").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
          End With
          
With Sheets("Blad12")
  .Range("A2") = "718.EXT"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 9, "718.EXT"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad12").Range("A3")
                Sheets("Blad12").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
         End With
         
With Sheets("Blad13")
  .Range("A2") = "726.KO"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 9, "726.KO"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad13").Range("A3")
                Sheets("Blad13").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
With Sheets("Blad14")
  .Range("A2") = "726.EW"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 9, "726.EW"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad14").Range("A3")
                Sheets("Blad14").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
 With Sheets("Blad17")
  .Range("A2") = "Alg. Contr. van alle onderd. LK's"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, Criteria1:="*nische controle", Operator:=xlOr, Criteria2:="=*trole van alle onderd*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad17").Range("A3")
              End With
       .AutoFilter 3, Criteria1:="*trole Sifa"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad17").Range("C500").End(xlUp).Offset(0, -2)
                Sheets("Blad17").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
          End With
          
 With Sheets("Blad18")
  .Range("A2") = "Alg. Contr. van alle onderd. TK"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, Criteria1:="*nische controle", Operator:=xlOr, Criteria2:="=*trole van alle onderd*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad18").Range("A3")
              End With
       .AutoFilter 3, Criteria1:="*trole Sifa"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad18").Range("C500").End(xlUp).Offset(0, -2)
                Sheets("Blad18").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
          End With
          
 With Sheets("Blad19")
  .Range("A2") = "Herst. na contr. LK's"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, Criteria1:="=*lingen na con*", Operator:=xlOr, Criteria2:="=*sther*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad19").Range("A3")
              End With
       .AutoFilter 3, Criteria1:="=*ling na con*", Operator:=xlOr, Criteria2:="=*ling voor con*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad19").Range("C500").End(xlUp).Offset(0, -2)
              End With
       .AutoFilter 3, Criteria1:="=*ling naar con*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad19").Range("C500").End(xlUp).Offset(0, -2)
                Sheets("Blad19").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
       End With
       
 With Sheets("Blad20")
  .Range("A2") = "Herst. na contr. TK"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, Criteria1:="=*lingen na con*", Operator:=xlOr, Criteria2:="=*sther*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad20").Range("A3")
              End With
       .AutoFilter 3, Criteria1:="=*ling na con*", Operator:=xlOr, Criteria2:="=*ling voor con*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad20").Range("C500").End(xlUp).Offset(0, -2)
              End With
       .AutoFilter 3, Criteria1:="=*ling naar con*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad20").Range("C500").End(xlUp).Offset(0, -2)
                Sheets("Blad20").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
       End With
       
 With Sheets("Blad21")
  .Range("A2") = "Stroomafnemers"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "*van de str*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad21").Range("A3")
                Sheets("Blad21").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
 With Sheets("Blad22")
  .Range("A2") = "Veiligheidsfunties"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "*Veiligheidsfunctie*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad22").Range("A3")
                Sheets("Blad22").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
 With Sheets("Blad23")
  .Range("A2") = "Isolatiemetingen"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "*na reini*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad23").Range("A3")
                Sheets("Blad23").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
 With Sheets("Blad24")
  .Range("A2") = "Reinigen motoren"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, Criteria1:="=*entie rei*", Operator:=xlOr, Criteria2:="=*entie fir*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad24").Range("A3")
                Sheets("Blad24").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
 With Sheets("Blad25")
  .Range("A2") = "Controle tonnenkoppelingen"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37

 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "*trole tonnenkop*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad25").Range("A3")
                Sheets("Blad25").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
 With Sheets("Blad26")
  .Range("A2") = "Smeren"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, Criteria1:="smering", Operator:=xlOr, Criteria2:="=*eren en ol*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad26").Range("A3")
              End With
       .AutoFilter 3, Criteria1:="=*eren alle ond*", Operator:=xlOr, Criteria2:="=*eren van alle ond*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad26").Range("C500").End(xlUp).Offset(0, -2)
              End With
       .AutoFilter 3, Criteria1:="=*eren : wie*", Operator:=xlOr, Criteria2:="=*eren : mot*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad26").Range("C500").End(xlUp).Offset(0, -2)
              End With
       .AutoFilter 3, Criteria1:="=*meren tak*", Operator:=xlOr, Criteria2:="=*eren : mot*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad26").Range("C500").End(xlUp).Offset(0, -2)
                Sheets("Blad26").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
With Sheets("Blad27")
  .Range("A2") = "Kraanbalken"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "*moeilijk bereikbare dele*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad27").Range("A3")
                Sheets("Blad27").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
With Sheets("Blad29")
  .Range("A2") = "APVV"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "APVV*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad29").Range("A3")
                Sheets("Blad29").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
 With Sheets("Blad30")
  .Range("A2") = "APVG"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "APVG*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad30").Range("A3")
                Sheets("Blad30").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
 With Sheets("Blad31")
  .Range("A2") = "CPB"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "CPB*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad31").Range("A3")
                Sheets("Blad31").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
 With Sheets("Blad32")
  .Range("A2") = "In voorbereiding"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 5, "In voorbereiding"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad32").Range("A3")
                Sheets("Blad32").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
 With Sheets("Blad33")
  .Range("A2") = "Curatief"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 6, "CURATIEF"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad33").Range("A3")
                Sheets("Blad33").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With

For Each cl In .Range("C2:C" & .Cells(Rows.Count, 3).End(xlUp).Row)

  If cl > 0 Then
       Set c = .Range("AA2:AT250").Find(cl, , xlValues, xlWhole)
       If Not c Is Nothing Then
    firstAddress = c.Address
    Do
    kolom = Mid(c.Address, 3, 1)
    Select Case kolom
    
 Case "A"
    With Sheets("Blad2").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad2")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad2").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
 Case "B"
    With Sheets("Blad3").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad3")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad3").Columns("E:K").HorizontalAlignment = xlCenter
    End With
      
 Case "C"
    With Sheets("Blad4").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad4")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad4").Columns("E:K").HorizontalAlignment = xlCenter
    End With
      
 Case "D"
    With Sheets("Blad5").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad5")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad5").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
 Case "E"
    With Sheets("Blad6").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad6")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad6").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
 Case "F"
    With Sheets("Blad7").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad7")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad7").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
 Case "G"
    With Sheets("Blad8").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad8")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad8").Columns("E:K").HorizontalAlignment = xlCenter
        'Sheets("Blad1").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
 Case "H"
    With Sheets("Blad9").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad9")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad9").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
 Case "N"
    With Sheets("Blad15").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad15")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad15").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
 Case "O"
    With Sheets("Blad16").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad16")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad16").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
 Case "T"
    With Sheets("Blad28").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad28")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad28").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
        End Select
        Set c = .Range("AA2:AT250").FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
     End If
   End If
   If Not cl Is Nothing Then
naam = cl
   End If
  Next cl

For i = .Range("C2:C" & .Cells(Rows.Count, 3).End(xlUp).Row).Rows.Count To 2 Step -1
If .Cells(i, 3) > 0 Then
       Set c = .Range("AA2:AT250").Find(.Cells(i, 3), , xlValues, xlWhole)
       If Not c Is Nothing Then
     .Cells(i, 3).Offset(, -2).Resize(, 11).Delete shift:=xlUp
   End If
  End If
 Next i
For i = .Range("I2:I" & .Cells(Rows.Count, 10).End(xlUp).Row).Rows.Count To 2 Step -1
If .Cells(i, 10) = "726.EW" Then .Cells(i, 1).Resize(, 11).Delete shift:=xlUp
 Next i
End With
 Dim wrksht As Worksheet
    For Each wrksht In Worksheets
      wrksht.Columns.AutoFit
    Next wrksht

    For i = 1 To 34
        Sheets("Blad" & i).Name = Choose(i, "Rest", "AA-Kranen", "A-Kranen", "B-Kranen", "C-Kranen", "Geen klasse", "Takels", "Zwenkkranen", "LK45xx", "718.MEC", "718.ELE", "718.EXT", "726.KO", "726.EW", "Dummy", _
            "Klein gereedschap", "A.C. van alle onderd. LK", "A.C. van alle onderd. TK", "Herst. na contr. LK", "Herst. na contr. TK", "Stroomafnemers", "Veiligheidsfuncties", _
            "Isolatiemetingen", "Reinigen motoren", "Tonnenkoppelingen", "Smeren", "Controle kraanbalken", "Tangen", "APVV", "APVG", "CPB", "In voorbereiding", "Curatief", "Samenvatting")
    Next
    For x = 1 To 33
   Sheets(Choose(x, "Rest", "AA-Kranen", "A-Kranen", "B-Kranen", "C-Kranen", "Geen klasse", "Takels", "Zwenkkranen", "LK45xx", "718.MEC", "718.ELE", "718.EXT", "726.KO", "726.EW", "Dummy", _
            "Klein gereedschap", "A.C. van alle onderd. LK", "A.C. van alle onderd. TK", "Herst. na contr. LK", "Herst. na contr. TK", "Stroomafnemers", "Veiligheidsfuncties", _
            "Isolatiemetingen", "Reinigen motoren", "Tonnenkoppelingen", "Smeren", "Controle kraanbalken", "Tangen", "APVV", "APVG", "CPB", "In voorbereiding", "Curatief", "Samenvatting")).Range("A2").AutoFilter
    Next
 With Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xlsx")
 Workbooks.Open "H:\Mijn documenten\Lijst_LK's2.xls"
    With .Sheets("Samenvatting")
        Workbooks("Lijst_LK's2.xls").Sheets(1).Range("B2:F40").Copy .Range("B2")
        .Columns("A:F").ColumnWidth = 27.86
    End With
 Workbooks("Lijst_LK's2.xls").Close False
 Windows("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xlsx").Activate
    hsv_1
    hsv_2
 With Application
    .ScreenUpdating = True
    .SheetsInNewWorkbook = 3
    .Save
 End With
 End With
 End With
End Sub

Sub hsv_1()
Dim ws As Long, cl As Range
For ws = 1 To 33
   With Sheets(ws)
For Each cl In .Range("I3:I" & .Cells(Rows.Count, 9).End(xlUp).Row)
  If WorksheetFunction.And(cl > 0, InStr(cl, "/") > 0) Then
        cl = DateValue(cl)
        cl.NumberFormat = "dd-mm-yyyy"
     Else
        cl = cl
    End If
   Next cl
  End With
 Next ws
End Sub

Sub hsv_2()
Dim ws As Long, Lrow As Long, i As Long, c As Range
Application.ScreenUpdating = False
 For ws = 17 To 20 'Sheets.Count
   With Sheets(ws)
    Lrow = .Cells(Rows.Count, 3).End(xlUp).Row
 For i = Lrow To 3 Step -1
    Set c = Sheets("Rest").Columns(25 + ws).Find(.Cells(i, 3), , xlValues, xlWhole)
 If c Is Nothing Then .Cells(i, 1).EntireRow.Delete
    Next i
End With
  Next ws
End Sub

Groetjes Danny. :thumb:

danny147 · 7 sep 2012

Beste HSV, :thumb:

Om maar terug met de deur in huis te vallen :d

Vandaag bestandje gemaakt en door gestuurd naar ons personeelsleden en ik kreeg een terechte opmerking:

De datums zijn bij ons in het Amerikaans systeem.
Het volgende opgemerkt:

Alle datums die kleiner zijn dan 13 worden omgezet in maanden.

Kan je volgende code aanpassen van zodra de datum kleiner is dan 13 --> format = mm/dd/yyyy
Datum groter dan 12 --> format = dd/mm/yyyy. (blijft zoals het is)

Code:

Sub hsv_2()
Dim ws As Long, cl As Range
For ws = 1 To 33
   With Sheets(ws)
For Each cl In .Range("I3:I" & .Cells(Rows.Count, 9).End(xlUp).Row)
  If WorksheetFunction.And(cl > 0, InStr(cl, "/") > 0) Then
        cl = DateValue(cl)
        cl.NumberFormat = "dd-mm-yyyy"
     Else
        cl = cl
    End If
   Next cl
  End With
 Next ws
End Sub.

Zie bestandje met voorbeeld.

Groetjes Danny. :thumb:

HSV · 7 sep 2012

Weet je het zeker wat je wilt, en wat de code doet.
Bij mij loopt het als een zonnetje.
Ik heb de code laten lopen en het resultaat staat in kolom O.

Het gewenste resultaat van jouw bestandje lijkt me niet wenselijk toch?

danny147 · 7 sep 2012

Beste HSV,

De gegevens die in kolom M staan zijn de gegevens uit het origineel bestand vanop mijn werk.
Onze landinstellingen staan op yyyy/MM/dd

Bij het lopen van de code wordt alles door elkaar gehaald.
Heb dan naar IT gebeld op mijn werk en kreeg het volgende terug via mail:

Klopt, enige oplossing hiervoor is je datum formaat op yyyy/MM/dd plaatsen op je pc.
Microsoft is immer amerikaans, en ze interpreteren datums altijd op hun manier MM/DD/yyyy

Daarom mijn vraag naar jouw gericht, alle datums die kleiner zijn dan 13 --> format mm/dd/yyyy
Is dit mogelijk ?

Groetjes Danny. :thumb:

HSV · 7 sep 2012

Knutsel hier eens wat mee Danny.

Uit je bericht wordt ik helaas niet veel wijzer.
Pc op yyyy-MM-dd, code op MM-dd-yyyy ??????

Code:

Cells(cl.Row, 15).NumberFormat = "mm-dd-yyyy"

Of:

Code:

 Cells(cl.Row, 15).NumberFormat = "mm/dd/yyyy"

danny147 · 7 sep 2012

Beste HSV,

Code is goed voor de verkeerde datums, maar zet nu 5/29/2012 ipv 29/5/2012.

Nu nog in de code: als dag kleiner is dan 13 dan format mm/dd/yyyy anders format dd/mm/yyyy.

Groetjes Danny. :thumb:

HSV · 7 sep 2012

Hoe komt die data daarin dat het gewijzigd moet worden.
Het gaat alleen om de datumfilters i.p.v. tekstfilters.

danny147 · 7 sep 2012

Beste HSV,

Dat is voor mij ook een raadsel, maar het is zo ???

Groetjes Danny. :thumb:

HSV · 7 sep 2012

Helaas kan ik het niet testen daar mijn gegevens juist zijn op mijn Pc.

Gegevens wegschrijven dmv lijst.

Terugkerende gebruiker

Inventaris

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Terugkerende gebruiker

Bijlagen

Inventaris

Bijlagen

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Wij waarderen jouw privacy