Opgenomen macro variabel maken

[Ron001]

Allen

Zou iemand willen/kunnen helpen met file in bijlage?
Boven zijn de geïmporteerde gegevens, onder zou het eindresultaat moeten worden.
Lay-out is steeds dezelfde, enkel de rijen zijn steeds variabel.
Daarom dat mijn opgenomen macro niet goed werkt.
Wat gebeurt er?

• Kolom F tot J (variabele rijen) knippen en plakken naar kolom E
• Als er twee dezelfde getallen in kolom I zijn, één van deze twee rijen verwijderen
• Alle rijen waarvan datum kleiner als vandaag (vandaag is variabel) is verwijderen
• Bij de regels die overblijven waar R INSPECTIE of P INSPECTIE staat alles na het woord INSPECTIE verwijderen (namen)
• De datum in kolom E vergelijken, zijn deze verschillend dan 2 lege rijen invoegen (alsook 2 lege rijen onder hoofding)
• De datum uit kolom E kopiëren naar kolom A (met lange datumnotitie en in het vet/rood)
• Alle fouten negeren
• Alle velden centreren en midden uitlijnen

Het is veel gevraagd maar kan iemand mij op weg zetten aub?

Bedankt!

Bekijk bijlage voorbeeld file.xlsm

 

[Gijsbert1]

Kun je hier iets mee?

Punt 1-4 Met VBA
Punt 5-6 Met draaitabel op ander tabblad.
Punt 7 Niet bekend wat je hiermee bedoelt?
punt 8 Gewoon met celopmaak gedaan.

 

[Ron001]

Alvast bedankt!

1-4 OKe

5-6 Kan punt 5-6 ook niet in code verwerkt worden, zodat het begin en voorbeeldbestand echt hetzelfde is (in mijn file)?

7- Bv onder de functieplaats geeft hij steeds fouten, dan neem ik alle fouten negeren en is deze vermelding weg...

8 -Ik had iets opgenomen van

    Selection.Font.Bold = True
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.NumberFormat = "[$-x-sysdate]dddd, mmmm dd, yyyy"

Waar selection dan een variabele moet zijn die elke datum in kolom A aanpast naar bovenstaande code.

 

[VenA]

With Columns(1).SpecialCells(2, 1).Font
  .Bold = True
  .Color = -16776961
  .Parent.NumberFormat = "[$-x-sysdate]dddd, mmmm dd, yyyy"
End With

 

[Ron001]

@ Vena

Heb je ook een oplossing voor punt 5-6?

Bedankt!

 

[VenA]

Volgens mij is de vraag op weg zetten. Wat heb je zelf al gedaan? Het idee van @Gijsbert1 met een draaitabel vind ik zo gek nog niet. Je kan onderstaande eens proberen en eventueel zelf aanpassen om alles binnen 1 macro te vangen.

Sub VenA()
  With Sheets("Gepland").Cells(1).CurrentRegion
    .Columns(5).SpecialCells(2).Offset(1).Delete
    .Columns(4).Replace "INSPECTIE*", "INSPECTIE"
    .RemoveDuplicates 9, xlYes
    .AutoFilter 5, "<" & Format(Date, "mm-dd-yyyy")
    .Offset(1).EntireRow.Delete
    .AutoFilter
    .Parent.Columns(1).NumberFormat = "General"
    
    For j = .Rows.Count To 2 Step -1
      If .Parent.Cells(j, 5) <> Cells(j - 1, 5) Then
        .Parent.Rows(j).Resize(2).Insert
        With .Parent.Cells(j + 1, 1)
          .Value = .Parent.Cells(j + 2, 5).Value
          With .Font
            .Bold = True
            .Color = -16776961
            .Parent.NumberFormat = "[$-x-sysdate]dddd, mmmm dd, yyyy"
          End With
        End With
      End If
    Next j
  End With
End Sub

 

[snb]

Gebruik de ingebouwde faciliteiten van Excel: advancedfilter.

Sub M_snb()
    with Blad1
       .Cells(1).CurrentRegion.Rows(1).Offset(, 5) = .Cells(1).CurrentRegion.Rows(1).Offset(, 4).Value
       .Columns(5).Delete
       .Cells(1, 13) = .Cells(1, 5).Value
       .Cells(2, 13) = CDate("17-10-2018")
       .Cells(1).CurrentRegion.AdvancedFilter 2, .Cells(1, 13).CurrentRegion, Sheet1.Cells(1)
    end with

    with Sheet1
       .Cells(1).CurrentRegion.RemoveDuplicates 9
       .Columns(4).Replace "Inspectie*", "Inspectie", 2
    end with
End Sub

 

[Ron001]

Allen bedankt voor de hulp…
Ik was verder op weg met de code van VenA (deze is me een beetje duidelijk, snb is Chinees voor mij)
Nu heb ik nog 3 probleempjes.

1ste
Ik wou de eerste letter van de datum (in lange notitie) in hoofdletter zetten met de StrConv functie,
maar dit lijkt me niet te lukken enkel voor de eerste letter. Kan ik hier beter andere functie voor gebruiken?

2de
Als ik de code in de file uitvoer, werkt deze prima.
Maar omdat de code ook vanaf lijn 2, 2 lege rijen invoegt, krijgen deze de opmaak van de titelbalk (grijs), ik had dus in module 2 iets fictief gezet om te kijken of de code die ik gebruikte (om deze terug wit te maken) werkte, werkt maar dan krijg je zoals in file in bijlage (rij 17:26) een beeld zonder cellijnen…

3de
Als de nummer in kolom I heztelfde is mag er één kolom verwijdert worden, ben iets te snel geweest.
Zoals de in het geel gemarkeerde lijnen, is deze nummer vier keer hetzelfde, maar het beginuur is anders.
Dus ik zou iets mijn voorwaarde willen dat als kolom I hetzelfde is en het beginuur anders, er geen drie rijen moeten verwijderd worden maar van elk beginuur één rij.
In dit geval zou dan rij 8 en 10 weg mogen.

Bekijk bijlage helpmij dubbele ploeg.xlsm

Edit: Gele lijnen vergeten te markeren(7 tem 10)

 

[VenA]

Punt 2 gebruik xlnone ipv vbwhite
Punt 3

.RemoveDuplicates Array(6, 9), xlYes

 

[Ron001]

Heb er nu dit van gemaakt...werkt inderdaad ze...
Maar kan ik voor punt 1 de StrConv functie gebruiken?

Sub VenA()
  With Sheets("Gepland").Cells(1).CurrentRegion
    .Columns(5).SpecialCells(2).Offset(1).Delete
    .Columns(4).Replace "INSPECTIE*", "INSPECTIE"
    .RemoveDuplicates Array(6, 9), xlYes
    .AutoFilter 5, "<" & Format(Date, "mm-dd-yyyy")
    .Offset(1).EntireRow.Delete
    .AutoFilter
    .Parent.Columns(1).NumberFormat = "General"
    
    For j = .Rows.Count To 2 Step -1
      If .Parent.Cells(j, 5) <> Cells(j - 1, 5) Then
        .Parent.Rows(j).Resize(2).Insert
        With .Parent.Cells(j + 1, 1)
          .Value = .Parent.Cells(j + 2, 5).Value
          With .Font
            .Name = "Calibri"
            .Size = 11
            .Bold = True
            .Color = -16776961
            .Parent.NumberFormat = "[$-x-sysdate]dddd, mmmm dd, yyyy"
          End With
            Range("A1:K100").Select
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
        End With
      End If
    Next j
  End With
  ActiveSheet.Rows("2:3").Cells.Interior.Color = xlNone
  Range("A1").Select
End Sub

 

[snb]

In het Nederlands en het Chinees beginnen datumnamen met een kleine letter.

 

[Ron001]

En als ik deze nu in het Engels wil?

 

[VenA]

In het Engels gaat het volgens mij automatisch goed.
StrConv werkt alleen op tekst.

With .Parent.Cells(j + 1, 1)
          .Value = StrConv(Format(.Parent.Cells(j + 2, 5).Value, "dddd, mmmm dd, yyyy"), 3)

 

[Ron001]

Bedankt!
Ik sluit het topic.