Gegevens wegschrijven dmv lijst.

danny147 · 6 mrt 2012

Beste HSV,

Dit loopt gesmeerd

:thumb:

Nu probeer ik blad1 zo klein mogelijk te houden, zodat deze lijst moet herzien worden.
De andere tabbladen daar kunnen wij ons werk uit halen.

Nu heb ik in bestand "Lijst_LK's.xls" 3 items bijgemaakt nl: DUMMY, KLEIN GEREEDSCHAP 718 en 726.EW

Heb volgende allemaal aangepast:

Code:

Application.SheetsInNewWorkbook = [COLOR="#FF0000"][B]7[/B][/COLOR]

Code:

Set C = .Range("AA2:A[COLOR="#FF0000"][B]F[/B][/COLOR]254").Find(cl, , xlValues, xlWhole)

Dit 3 maal voor Case D, E en F

Code:

 Case "[B][COLOR="#FF0000"]D[/COLOR][/B]"
    With Sheets("Blad5").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 10).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 9) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad5")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 10) = cl.Offset(, -1).Resize(, 10).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 10)).Sort .Cells(Rij - 1, 9), , , , , , , xlYes
    End With

Voor D en E geen enkel probleem omdat het hetzelfde zoekfuncties zijn als de vorige.

Voor F moet er gezocht worden in kolom I nl. op 726.EW
In cel A2 zou dan ook 726.EW moeten komen.
Ook al deze gegevens moeten verwijderd worden in blad1

Hopelijk begrijp je me, anders toon ik het aan met een voorbeeldje.

Groetjes Danny. :thumb:

HSV · 6 mrt 2012

Danny,

als 'D & E' geen problemen geeft, dan hier 'F' voor blad7.

Code:

Dim cl      As Range
    Dim C       As Variant
    Dim Rij     As Long
    
Application.ScreenUpdating = False
 sq = "Roepnaam" & "|" & "Machine" & "|" & "Omschrijving" & "|" & "Werkorder" & "|" & "Status" & "|" & "BeginTijdstipGepland" _
& "|" & "EindTijdstipGepland" & "|" & "CapacitaitsgroepID" & "|" & "Werkvoorbereider" & "|"
 
 [COLOR="#FF0000"]With Sheets("Blad7")
  .Range("A1") = "726.EW"
  .Range("B1").Resize(, 9) = Split(sq, "|")
  .Range("A1:J1").Interior.ColorIndex = 37
 End With

With Sheets("Blad1")
 With .Range("A2:J" & .Cells(Rows.Count, 10).End(xlUp).Row)
       .AutoFilter 8, "726.EW"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad7").Range("A2")
                .Delete shift:=xlUp
              End With
            .AutoFilter
        End With[/COLOR]
For Each cl In .Range("C2:C" & .Cells(Rows.Count, 3).End(xlUp).Row)

danny147 · 6 mrt 2012

Beste HSV,

Met onderstaande aangepaste code lukt het wel

Code:

 With Sheets("Blad7")
  .Range("A1") = "726.EW"
  .Range("B1").Resize(, 9) = Split(sq, "|")
  .Range("A1:J1").Interior.ColorIndex = 37
 End With

With Sheets("Blad1")
 With .Range("A2:J" & .Cells(Rows.Count, 10).End(xlUp).Row)
       .AutoFilter [COLOR="#FF0000"][B]9[/B][/COLOR], "726.EW"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad7").Range("A2")
                .Delete shift:=xlUp
              End With
            .AutoFilter
        End With

Morgen nog eens testen op het werk.

Groetjes Danny. :thumb:

danny147 · 8 mrt 2012

Beste HSV,

Dit is grondig getest en OK bevonden. :thumb:

Bedankt voor de medewerking en tot de volgende topic hé :thumb: :d

Groetjes Danny. :thumb:

danny147 · 14 mrt 2012

Beste HSV,

Veronderstel dat in de lijst met LK's de naam 2x voorkomt.
Hoe komt het dan dat ik deze maar 1x zie in de tabbladen ?

Vb. in lijst bij kolom AA staat LK101 en in lijst bij kolom AC staat ook LK101, deze zie ik dan maar 1x op tabblad 2 en niet in tabblad 4

Kan jij dit oplossen als je de draad nog kan oprapen :d

Groetjes Danny :thumb:

HSV · 14 mrt 2012

Danny,

Dan zou je er een loop om heen moeten zetten met een findnext cl.

danny147 · 14 mrt 2012

Beste HSV

Je zat te wachten op mijn vraag zeker

Zo snel heb ik je nog nooit zien antwoorden

Kan je findnext cl. dat erin verwerken of vraag dit te veel tijd ?

Anders kan ik mij redden door de code te kopiëren en het lijstje aan te passen.

Groetjes Danny. :thumb:

HSV · 14 mrt 2012

Met mijn postvak open komt er vanzelf een berichtje. :d
Ik zal even de gegevens weer bij elkaar zoeken, als ik ze nog niet heb verwijderd.
Ik reageer wel weer.

HSV · 14 mrt 2012

Het stuk tussen de ********* is veranderd Danny.
De rode regelcodes dus.

Code:

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

  If cl > 0 Then
       Set C = .Range("AA2:AC254").Find(cl, , xlValues, xlWhole)
       If Not C Is Nothing Then
     [COLOR="#FF0000"]firstAddress = C.Address
    Do[/COLOR] 
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(, 10).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 9) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad2")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 10) = cl.Offset(, -1).Resize(, 10).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 10)).Sort .Cells(Rij - 1, 9), , , , , , , xlYes
    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(, 10).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 9) = Split(sq, "|")
        End If
      End With
    With Sheets("Blad3")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 10) = cl.Offset(, -1).Resize(, 10).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 10)).Sort .Cells(Rij - 1, 9), , , , , , , xlYes
    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(, 10).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 9) = Split(sq, "|")
        End If
      End With
    With Sheets("Blad4")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 10) = cl.Offset(, -1).Resize(, 10).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 10)).Sort .Cells(Rij - 1, 9), , , , , , , xlYes
    End With
       End Select
    [COLOR="#FF0000"] Set C = .Range("AA2:AC254").FindNext(C)
   Loop While Not C Is Nothing And C.Address <> firstAddress[/COLOR]    
   End If
  End If
'*****************************************************************
   If Not cl Is Nothing Then
naam = cl
   End If
  Next cl

danny147 · 15 mrt 2012

Beste HSV

So far so good :thumb:

Heb er nog een extraatje ingestoken (groen gekleurd), iets wat we nog niet gezien hebben in mijn code

Ik zou graag in kolom 4 willen zoeken op AutoFilter 4, Criteria1:="=*van de str*"

Ik zit met het probleem dat hij alles al verwijderd alvorens ik dit kan uitvoeren.
Het verwijderen van de lijst moet hij op het laatste uitvoeren.
De code staat er 2 maal in voor alles te verwijderen (rood gekleurd)

Zie stukje code:

Code:

        Set C = .Range("AA2:AG254").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
[COLOR="#FF0000"]  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:AG254").Find(.Cells(i, 3), , xlValues, xlWhole)
       If Not C Is Nothing Then
     .Cells(i, 3).Offset(, -2).Resize(, 10).Delete shift:=xlUp[/COLOR]   End If
  End If
 Next i
End With
    
 With Sheets("Blad7")
  .Range("A2") = "726.EW"
  .Range("B2").Resize(, 9) = Split(sq, "|")
  .Range("A2:J2").Interior.ColorIndex = 37
 End With

With Sheets("Blad1")
 With .Range("A2:J" & .Cells(Rows.Count, 10).End(xlUp).Row)
       .AutoFilter 9, "726.EW"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad7").Range("A3")
                .Delete shift:=xlUp
              End With
            .AutoFilter
        End With

[COLOR="#00FF00"] With Sheets("Blad9")
  .Range("A2") = "Stroomafnemers"
  .Range("B2").Resize(, 9) = Split(sq, "|")
  .Range("A2:J2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:J" & .Cells(Rows.Count, 10).End(xlUp).Row)
       .AutoFilter 4, Criteria1:="=*van de str*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad9").Range("A3")
                '.Delete shift:=xlUp
              End With
            .AutoFilter
        End With[/COLOR] 
[COLOR="#FF0000"]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:AG254").Find(.Cells(i, 3), , xlValues, xlWhole)
       If Not C Is Nothing Then
     .Cells(i, 3).Offset(, -2).Resize(, 10).Delete shift:=xlUp[/COLOR]   End If
  End If
 Next i
End With

Dim wrksht As Worksheet
    For Each wrksht In Worksheets
        wrksht.Columns.AutoFit
    Next wrksht
 Sheets("Blad1").Name = "Rest"
 Sheets("Blad2").Name = "AA-Kranen"
 Sheets("Blad3").Name = "A-Kranen"
 Sheets("Blad4").Name = "Andere Kranen"
 Sheets("Blad5").Name = "Dummy's"
 Sheets("Blad6").Name = "Klein gereedschap"
 Sheets("Blad7").Name = "726.EW"
 Sheets("Blad8").Name = "LK45xx"
 Sheets("Blad9").Name = "Stroomafnemers"
 
Application.ScreenUpdating = True
Application.SheetsInNewWorkbook = 3
 .Close True

End With
End Sub

Groetjes Danny.

HSV · 15 mrt 2012

Trek je de gehele code uit elkaar.
Bij mij staat onderstaande

Code:

With Sheets("Blad7")
  .Range("A2") = "726.EW"
  .Range("B2").Resize(, 9) = Split(sq, "|")
  .Range("A2:J2").Interior.ColorIndex = 37
 End With

With Sheets("Blad1")
 With .Range("A2:J" & .Cells(Rows.Count, 10).End(xlUp).Row)
       .AutoFilter 9, "726.EW"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad7").Range("A3")
                .Delete shift:=xlUp
              End With
            .AutoFilter
        End With

in het begin van de gehele code.
Je zou het eventueel daar onder kunnen zetten.

danny147 · 15 mrt 2012

Beste HSV

In bijlage een excel bestandje met daarin de volledige code.

Hoe zou jij het rangschikken met de groene code ermee in verwerkt.

de code waar ik 726.EW ophaal, deze mogen direct verwijderd worden zoals nu het geval is.
de code waar ik AutoFilter 4, Criteria1:="=*van de str*" ophaal deze moeten daarna niet verwijderd worden.
Dit moet automatisch gebeuren op het laatst.

Groetjes Danny. :thumb:

HSV · 15 mrt 2012

Danny,

Ik heb het op een andere plaats gezet.
De code wordt iets sneller doordat het de delete rijen niet meer hoeft te doorlopen.
Ik heb het niet getest.

danny147 · 16 mrt 2012

Beste HSV,

Heb het uitgetest op mijn werk en...

- Gegevens van 726.EW worden niet zichtbaar in tabblad 7
- Gegevens van Stroomafnemers worden niet zichtbaar in tabblad 9
- Bestand is trager dan vroeger, nu meer dan 1 min buiten anders 15 sec.

Groetjes Danny.

HSV · 16 mrt 2012

Danny,

In mijn testbestand

Code:

.AutoFilter 8, "726.EW"

Code:

.AutoFilter 3, Criteria1:="=*van de str*"

Code zou mijn inziens sneller moeten zijn, de gegevens van 726.EW worden verwijderd, dus hoeven niet meer doorlopen te worden door 'For Each cl'.

danny147 · 16 mrt 2012

Beste HSV

Hier zijn geen woorden voor

Waarom lukt het de vorige keer wel met :

Code:

.AutoFilter 9, "726.EW"

Deze topic mag terug eventjes gesloten worden tot wanneer het volgende probleem zich stelt :d

Bedankt Harry :thumb: :thumb: :thumb:

Groetjes Danny. :thumb:

HSV · 16 mrt 2012

Hoi Danny,

In post #63 maakte jij van de '8', er een '9' van.

Ik heb geen idee waarom het bij jou werkte.
Kolom A is immers leeg.

Graag gedaan, en ik verneem het wel weer.
Je maakt het wel steeds groter en uitgebreider.
Mijn Pc is ±2½ jaar oud, maar komt qua snelheid al weer tekort.
Je code doet er bij mij wel een tijdje over. :d

danny147 · 16 mrt 2012

Beste HSV

Ik zit nu aan 12 tabbladen en deze worden uitgevoerd nog binnen de minuut.

Kan je dit er nog in verwerken ?

Code:

    Columns("E:J").Select
    With Selection
        .HorizontalAlignment = xlCenter
    End With

In onderstaande stukje code.

Code:

With Sheets("Blad7")
  .Range("A2") = "726.EW"
  .Range("B2").Resize(, 9) = Split(sq, "|")
  .Range("A2:J2").Interior.ColorIndex = 37
 End With

With Sheets("Blad1")
 With .Range("A2:J" & .Cells(Rows.Count, 10).End(xlUp).Row)
       .AutoFilter 8, "726.EW"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad7").Range("A3")
                .Delete shift:=xlUp
              End With
            .AutoFilter
        End With

Groetjes Danny. :thumb:

HSV · 16 mrt 2012

Zo snel al een nieuwe vraag? :d

Code:

With Sheets("Blad1")
 With .Range("A2:J" & .Cells(Rows.Count, 10).End(xlUp).Row)
       .AutoFilter 8, "726.EW"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad7").Range("A3")
                [COLOR="#FF0000"]Sheets("Blad7").Columns("E:J").HorizontalAlignment = xlCenter[/COLOR]
                .Delete shift:=xlUp
              End With
            .AutoFilter
        End With

danny147 · 16 mrt 2012

Beste HSV

Bedankt hé

Groetjes Danny. :thumb:

Gegevens wegschrijven dmv lijst.

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Bijlagen

Inventaris

Bijlagen

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Wij waarderen jouw privacy