Gegevens wegschrijven dmv lijst.

danny147 · 16 mrt 2012

Beste HSV

Hier ben ik dan weer met het volgende dat ik niet gezien hebt

Bij tabblad Rest, verwijderd hij niet alle regels die in het lijstje staan.
Het gaat hierom 1557 regels die blijven staan.

Enig vermoeden hoe dit komt ?

Groetjes Danny. :thumb:

HSV · 16 mrt 2012

Kijk eens of het bereik wel klopt.

Code:

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 = [COLOR="#FF0000"].Range("AA2:AG254").Find(.Cells(i, 3[/COLOR]), , xlValues, xlWhole)
       If Not C Is Nothing Then
     .Cells(i, 3).Offset(, -2).Resize(, 10).Delete shift:=xlUp
   End If
  End If
 Next i
End With

danny147 · 16 mrt 2012

Beste HSV

Het bereik klopt, dit is niet gewijzigd !

Groetjes Danny. :thumb:

danny147 · 16 mrt 2012

Beste HSV

Wordt er wel verwezen naar het lijstje waar het bereik staat (Lijst_LK's.xls) ?
En naar tabblad 1, waar de gegevens moeten verwijderd worden ?

Groetjes Danny. :thumb:

HSV · 17 mrt 2012

Het komt hier door.

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")
                Sheets("Blad7").Columns("E:J").HorizontalAlignment = xlCenter
               [COLOR="#FF0000"] .Delete shift:=xlUp[/COLOR]
              End With
            .AutoFilter
        End With

Ze zitten op één en dezelfde rij, en verwijderd alvast de gegevens.
Zet de rode regel eens in tekst.

danny147 · 17 mrt 2012

Beste HSV

Nu zijn alle waarden met LK weg in kolom C :thumb:
Maar in kolom I blijven alle waarden met 726.EW wel staan

De waarden met 726.EW hebben geen LK staan in kolom C
De uitvoerders van 726.EW werken niet op LoopKranen maar in de binnendienst, waar de machines staan.
Ik zie eingelijk het probleem niet waarom hij het bij de vorige code het wel deed

Kan je hier nog eens naar kijken hoe ik deze dan apart kan verwijderen ?

Groetjes Danny. :thumb:

HSV · 17 mrt 2012

Zet het oranje stukje hier neer Danny.
Het wordt er beslist niet sneller op.

Code:

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, 1).Resize(, 10).Delete shift:=xlUp
   End If
  End If
 Next i

[COLOR="#FF8C00"]For i = .Range("I2:I" & .Cells(Rows.Count, 9).End(xlUp).Row).Rows.Count To 2 Step -1
If .Cells(i, 9) = "726.EW" Then .Cells(i, 1).Resize(, 10).Delete shift:=xlUp
 Next i
End With[/COLOR]

danny147 · 17 mrt 2012

Beste HSV

Zou je ook eens kolom H de format willen veranderen naar "dd-mm-yyyy"
Dan kunnen we daarna sorteren op kleiner dan vandaag, dit lukt nu niet.

Dit mag tussen de volgende code geplaatst worden:

Code:

With Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xls")
     With .Sheets(1)
        On Error Resume Next
            .Range("J2:J13000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
            .Range("B3:J13000").Sort Key1:=Range("C2"), Order1:=xlAscending
              Workbooks.Open "D:\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 10 'kolommen
                    .Cells(i, j) = RTrim(.Cells(i, j))

Groetjes Danny. :thumb:

HSV · 17 mrt 2012

Danny,

Deze mag je daar precies onder toevoegen.

Code:

.Cells(i, 8) = Split(.Cells(i, 8))

danny147 · 17 mrt 2012

Beste HSV

Heb regeltje van jou geprobeerd, maar dat geeft geen resultaat.

Heb dan het volgende ingevoegd:

Code:

.Range("H3:H13000").NumberFormat = "dd/mm/yyyy"

Na deze regel:

Code:

.Range("J2:J13000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

maar dat gaat heel traag:

Wat ik wil is dat er in kolom H gewoon de datum komt te staan zonder uren en min erachter. (dd-mm-yyyy)

Het oranje stukje code werkt perfect.

Groetjes Danny. :thumb:

HSV · 17 mrt 2012

Dit werkt redelijk bij mij.

Code:

For i = 1 To .UsedRange.Rows.Count 'rijen
                    For j = 1 To 10 'kolommen
                    .Cells(i, j) = RTrim(.Cells(i, j))
                    .Cells(i, 8) = Split(.Cells(i, 8))
                   Next j
                Next i

De meeste cellen krijgen dd-mm-jjjj, een enkele d-mm-jjjj.
Het ligt er aan hoe de cel tevoren is opgemaakt in het origineel.

Met numberformat of format kreeg ik niet het gewenste resultaat, doordat er verschillende notaties in staan.
Sommige cellen worden dan als: 17-3-2012 00-00-00

danny147 · 17 mrt 2012

Beste HSV

Als ik deze dan wil sorteren van klein naar groot, krijg ik het volgende:
Als het allemaal gewone data's moesten zijn, kon ik sorteren op data's, dit lukt niet in dit geval.

1-1-2015
1-1-2015
1-12-2013
12-12-2011
12-8-2010
13-1-2012
14-5-2012
14-5-2012
16-2-2012

Hij sorteerd op dag maar niet op dag, maand en jaar !

Groetjes Danny. :thumb:

HSV · 18 mrt 2012

Danny,

Dit is de enige manier die mij lukte, om al de verschillende notaties terug te verkrijgen naar een juiste datumformaat.

Code:

 Next j
 Next i
[COLOR="#FF8C00"]For Each cdt In .Columns(8).SpecialCells(2)
    cdt.Value = Split(cdt.Value)
       If cdt Like "##-##-####" Or cdt Like "##-#-####" Or cdt Like "#-#-####" Or cdt Like "#-##-####" Then
         cdt.Value = DateValue(cdt)
         cdt.NumberFormat = "dd-mm-yyyy"
              End If
             Next cdt[/COLOR]               .Range("B2:J" & .Cells.SpecialCells(11).Row).AutoFormat Format:=xlRangeAutoFormatClassic1
               .Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
               .Columns.AutoFit
            End With

danny147 · 18 mrt 2012

Beste HSV

Wederom is dit weer perfect. :thumb:

Nu kan er teminste gefilter worden op Datumfilters, daarvoor was het telkens Tekstfilters.

Heb nog wat toevoegingen gedaan, zoals filters geplaatst op sommige tabbladen.

Zit nu aan 15 tabbladen en hij gaat net boven de minuut om dit klaar te spelen.

Als er nog vragen zijn dan hoor je nog van mij :d

Bedankt Harry :thumb:

Groetjes Danny. :thumb:

danny147 · 18 mrt 2012

Beste HSV

Het volgende :d

Heb gezien dat een filter beperkt is tot 2 criteria's zowel in Excel als in VBA.

Is er een mogelijkheid om op meerdere criteria's te filteren.

Dit zou ik willen:

Code:

.AutoFilter 3, Criteria1:="=*gen na co*", Operator:=xlOr, Criteria2:="=*sther*", Operator:=xlOr, Criteria3:="=*gen naar co*" Operator:=xlOr, Criteria4:="=*ing na co*"

Groetjes Danny. :thumb:

HSV · 18 mrt 2012

Je kan het misschien in meerdere sessies uitvoeren.
1e filter keer: doe je ding.
filter uit.
2e filter keer: doe je ding.

danny147 · 18 mrt 2012

Beste HSV

Het gaat om dit stukje code:

Code:

 With Sheets("Blad13")
  .Range("A2") = "Isolatiemetingen"
  .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 3, Criteria1:="=*gen na co*", Operator:=xlOr, Criteria2:="=*sther*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad13").Range("A3")
                Sheets("Blad13").Columns("E:J").HorizontalAlignment = xlCenter
              End With
            Range("A2").AutoFilter
        End With

Hierna moet dus het 2de deel komen van de crteria:

Code:

.AutoFilter 3, Criteria1:="=*gen naar co*" Operator:=xlOr, Criteria2:="=*ing na co*"

Hoe het 2de deel eraan koppelen, met End(xlup) ?

Groetjes Danny. :thumb:

Warme bakkertje · 19 mrt 2012

Al eens gedacht aan AdvancedFilter (Uitgebreid Filter) ?

HSV · 19 mrt 2012

Geen gek idee Rudi.

Hierbij een voorbeeld Danny.

danny147 · 19 mrt 2012

Beste HSV

Met onderstaane code lukt het, behalve de Autofilter wil hij niet plaatsen.
Misschien kan jij de code korter maken ?

Code:

 With Sheets("Blad13")
  .Range("A2") = "Isolatiemetingen"
  .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 3, Criteria1:="=*lingen na co*", Operator:=xlOr, Criteria2:="=*sther*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad13").Range("A3")
              End With
        End With
With Sheets("Blad1")
 With .Range("A2:J" & .Cells(Rows.Count, 10).End(xlUp).Row)
        .AutoFilter 3, Criteria1:="=*ling naar co*", Operator:=xlOr, Criteria2:="=*ling na co*"
        With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad13").Range("C100").End(xlUp).Offset(0, -2)
                Sheets("Blad13").Columns("E:J").HorizontalAlignment = xlCenter
              End With
            [COLOR="#FF0000"].Range("A2").AutoFilter[/COLOR]        End With
        End With

@ Warme bakkertje

Ik zou niet weten hoe eraan te beginnen, daar de gegevens opgehaald worden van tabblad1.
Alvast bedankt voor het meedenken.

Groetjes Danny. :thumb:

Gegevens wegschrijven dmv lijst.

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Meubilair

Inventaris

Bijlagen

Terugkerende gebruiker

Wij waarderen jouw privacy