• 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.

Redelijk ingewikkelde macro (In my opinion)

  • Onderwerp starter Onderwerp starter Nikeo
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
N

Nikeo

Gebruiker
Lid geworden
8 jul 2015
Berichten
31
Beste forum leden,

ik heb wat hulp nodig bij voorbeeld file in bijlage.
in volgende file dienen enkele stappen uitgevoerd te worden achter elkaar. ik ken, excel maar ben niet goed genoeg in macro's om het achter elkaar te bouwen.
Ik heb geprobeerd om de macro te recorden maar heb destijds een macro gevraagd en toen gemerkt dat als ik hier de formule aanvraag dat het veel korter en sneller gaat.
Stap 1 is het hernoemen van Export en Export (2) Naar respectievelijk Export BE en Export NL
Stap 2 Is het verwijderen van kolom CDEFHMNOQTUV in Export BE (Oude Export)
Stap 3 Is het verwijderen van kolom CDEFHKMNQRSTV in Export NL (Export (2) )
Stap 4 Is het plaatsen van de formule die e_mail en NX_CORRECTION_EMAIL Waarbij ik op dit moment de formule =IF(TRIM(NX_CORRECTION_EMAIL) = "";e_mail;NX_CORRECTION_EMAIL)
(bedoeling is om te gaan kijken als er een waarde in NX_CORRECTION_EMAIL staat dan dient deze de waarde in email te vervangen dit dient te gebeuren in een extra derde kolom genaamd Email)
Stap 5 Is het verwijderen vervolgens van Nx correction Email en Email
Stap 6 is het kopieren van alle data vanuit Export BE naar een extra tabblad genaamd Remote maintenance
Stap 7 Verwijderen van de kolom Last handling time
Stap 8 kopieren van alle data met als filter volgende zaken (Enkel voor Export BE):

Kolom qualificationDescription bevat OK Sold , rem_pf bevat BEDU >>> Nieuw tabblad genaamd Sold BeNL
Kolom qualificationDescription bevat OK Sold , rem_pf bevat BEFR >>> Nieuw tabblad genaamd Sold BeFR
Kolom qualificationDescription bevat Info Request , rem_pf bevat BEDU >>> Nieuw tabblad genaamd Info BeNL
Kolom qualificationDescription bevat Info Request , rem_pf bevat BEFR >>> Nieuw tabblad genaamd Info BeFR

Bekijk bijlage 298995

Alvast bedankt!
 

Bijlagen

Laatst bewerkt:
Als jullie wensen kan ik de recorded macro hier ook posten maar ik weet niet of dit van grote hulp zal zijn.

Ik heb destijds een mini macro aangepast van op dit forum voor het opsplitsen van de data in cellen gebasseerd op 1 kolom

Sub VenA()
Dim j As Long, c00 As String
With Sheet1
.[Z1] = .[A1]
For j = 0 To UBound(Split("OK Sold|Info Request|Geannuleerd", "|"))
c00 = Split("OK Sold|Info Request|Geannuleerd", "|")(j)
If IsError(Evaluate(c00 & "!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = c00
.[Z2] = c00
.Cells(1).CurrentRegion.AdvancedFilter xlFilterCopy, .[Z1:Z2], Sheets(c00).Cells(1)
Next j
.[Z1:Z2].ClearContents
End With
End Sub
 
Ik zou zeggen: het xlsm bestand inclusief macro lijkt mij een iets beter idee :)
 
Code plaatsen en bestand opslaan.
Als je de code uitvoert zijn er al een aantal dingen veranderd, beschrijf dan eens wat er nog moet gebeuren.

stap 1, 2 en 3.
Code: 
Sub hsv()
Dim i as long
For i = 1 To 2
 With Sheets(i)
     .Name = "Export " & IIf(i = 1, "BE", "NL")
     .Range(IIf(i = 1, "C1,D1,E1,F1,H1,M1,N1,O1,Q1,T1,U1,V1", "C1,D1,E1,F1,H1,K1,M1,N1,Q1,R1,S1,T1,V1")).EntireColumn.Delete
  End With
 Next i
End Sub
 
HSV zei:
Code plaatsen en bestand opslaan.
Als je de code uitvoert zijn er al een aantal dingen veranderd, beschrijf dan eens wat er nog moet gebeuren.

stap 1, 2 en 3.
Code: 
Sub hsv()
Dim i as long
For i = 1 To 2
 With Sheets(i)
     .Name = "Export " & IIf(i = 1, "BE", "NL")
     .Range(IIf(i = 1, "C1,D1,E1,F1,H1,M1,N1,O1,Q1,T1,U1,V1", "C1,D1,E1,F1,H1,K1,M1,N1,Q1,R1,S1,T1,V1")).EntireColumn.Delete
  End With
 Next i
End Sub
Klik om te vergroten...

Hey HSV,

eerst en vooral bedankt dat je hier je tijd aan spendeert.

Volgende stappen dienen nu te gebeuren:

Stap 1 Is het plaatsen van de formule die e_mail en NX_CORRECTION_EMAIL Waarbij ik op dit moment de formule =IF(TRIM(NX_CORRECTION_EMAIL) = "";e_mail;NX_CORRECTION_EMAIL)
(bedoeling is om te gaan kijken als er een waarde in NX_CORRECTION_EMAIL staat dan dient deze de waarde in email te vervangen dit dient te gebeuren in een extra derde kolom genaamd Email)
Stap 2 Is het verwijderen vervolgens van Nx correction Email en Email
Stap 3 is het kopieren van alle data vanuit Export BE naar een extra tabblad genaamd Remote maintenance (Enkel indien er in kolom A Ok SOLD staat)
Stap 4 Verwijderen van de kolom Last handling time
Stap 5 kopieren van alle data met als filter volgende zaken (Enkel voor Export BE):

Kolom qualificationDescription bevat OK Sold , rem_pf bevat BEDU >>> Nieuw tabblad genaamd Sold BeNL
Kolom qualificationDescription bevat OK Sold , rem_pf bevat BEFR >>> Nieuw tabblad genaamd Sold BeFR
Kolom qualificationDescription bevat Info Request , rem_pf bevat BEDU >>> Nieuw tabblad genaamd Info BeNL
Kolom qualificationDescription bevat Info Request , rem_pf bevat BEFR >>> Nieuw tabblad genaamd Info BeFR
 
Stap 1:
Druk op de reageerknop ipv de quoteknop.

Test het maar eens.
Code: 
Sub hsv()
Dim i As Long, j As Long, sh As Worksheet
For i = 1 To 2
 With Sheets(i)
    .Name = "Export " & IIf(i = 1, "BE", "NL")
    .Range(IIf(i = 1, "C1,D1,E1,F1,H1,M1,N1,O1,Q1,T1,U1,V1", "C1,D1,E1,F1,H1,K1,M1,N1,Q1,R1,S1,T1,V1")).EntireColumn.Delete
    .Columns(3).Insert
    .Cells(1, 3) = "e_mail"
    .Range("c2", .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 3)).Name = "bereik"
    If i = 1 Then
      [bereik] = [if(offset(bereik,,2)="",offset(bereik,,4),offset(bereik,,2))]
      .Range("E1,G1").EntireColumn.Delete
    Else
      [bereik] = [if(offset(bereik,,3)="",offset(bereik,,7),offset(bereik,,3))]
      .Range("F1,J1").EntireColumn.Delete
    End If
  End With
  Next i
   For j = 1 To 5
     Sheets.Add(, Sheets(Sheets.Count)).Name = Choose(j, "Remote maintenance", "Sold BeNL", "Sold BeFR", "Info BeNL", "Info BeFR")
   Next j
        With Sheets("Export BE").UsedRange
         .AutoFilter 1, "OK Sold"
         .Copy Sheets("Remote maintenance").Cells(1)
         .AutoFilter 7, "BEDU"
         .Copy Sheets("Sold BeNL").Cells(1)
         .AutoFilter 7, "BEFR"
         .Copy Sheets("Sold BeFR").Cells(1)
         .AutoFilter 1, "Info Request"
         .Copy Sheets("Info BEFR").Cells(1)
         .AutoFilter 7, "BEDU"
         .Copy Sheets("Info BeNL").Cells(1)
         .AutoFilter
        End With
    Sheets("Remote maintenance").Columns(2).Delete
  For Each sh In ThisWorkbook.Sheets
   sh.Columns.AutoFit
  Next sh
End Sub
 
Laatst bewerkt:
De formule heeft alles bijna af en dit in een record tijd.

Is er een mogelijkheid dat je voor hij alles over zet naar de apparte tabbladen de volgende wijzigingen aanbrengt:
city veranderen naar Stad post
street1 veranderen naar Adres post
zip veranderen naar postcode post
fname veranderen naar first name

Kan je me eventueel ook lectuur aanraden of een cursus die jij hebt gevolgd om dit te kunnen?
 
Alle bladen dus.
 
ja inderdaad dus mischien best voor hij de cellen kopieert sorry die stap was ik idd vergeten ik wist ook niet dat dit zo vlot en snel kon gaan
 
Als alleen Export BE ook goed is.
Code: 
Sub hsv()
Dim i As Long, j As Long, jj As Long, sh As Worksheet
For i = 1 To 2
 With Sheets(i)
    .Name = "Export " & IIf(i = 1, "BE", "NL")
    .Range(IIf(i = 1, "C1,D1,E1,F1,H1,M1,N1,O1,Q1,T1,U1,V1", "C1,D1,E1,F1,H1,K1,M1,N1,Q1,R1,S1,T1,V1")).EntireColumn.Delete
    .Columns(3).Insert
    .Cells(1, 3) = "e_mail"
    .Range("c2", .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 3)).Name = "bereik"
    If i = 1 Then
      [bereik] = [if(offset(bereik,,2)="",offset(bereik,,4),offset(bereik,,2))]
      .Range("E1,G1").EntireColumn.Delete
      For jj = 6 To 9
        .Cells(1, jj) = Choose(jj - 5, "Stad post", "Adres post", "Postcode post", "first name")
      Next jj
    Else
      [bereik] = [if(offset(bereik,,3)="",offset(bereik,,7),offset(bereik,,3))]
      .Range("F1,J1").EntireColumn.Delete
    End If
  End With
  Next i
   For j = 1 To 5
     Sheets.Add(, Sheets(Sheets.Count)).Name = Choose(j, "Remote maintenance", "Sold BeNL", "Sold BeFR", "Info BeNL", "Info BeFR")
   Next j
        With Sheets("Export BE").UsedRange
         .AutoFilter 1, "OK Sold"
         .Copy Sheets("Remote maintenance").Cells(1)
         .AutoFilter 7, "BEDU"
         .Copy Sheets("Sold BeNL").Cells(1)
         .AutoFilter 7, "BEFR"
         .Copy Sheets("Sold BeFR").Cells(1)
         .AutoFilter 1, "Info Request"
         .Copy Sheets("Info BEFR").Cells(1)
         .AutoFilter 7, "BEDU"
         .Copy Sheets("Info BeNL").Cells(1)
         .AutoFilter
        End With
    Sheets("Remote maintenance").Columns(2).Delete
  For Each sh In ThisWorkbook.Sheets
   sh.Columns.AutoFit
  Next sh
End Sub

Ik kan je helaas geen lectuur aanraden, ik heb zelf nog nooit een ingezien.
 
Dit werkt inderdaad perfect zou je enkel export Nl nog dezelfde benaming kunnen geven?
Hoe heb je dit dan geleerd?
 
Vanaf diverse fora en de Vba-Help van Excel.
Makkelijk beginnen, nabootsen\veranderen en goed kijken\opletten\volgen wat er gebeurt.

Code: 
Sub hsv()
Dim i As Long, j As Long, sh As Worksheet
For i = 1 To 2
 With Sheets(i)
    .Name = "Export " & IIf(i = 1, "BE", "NL")
    .Range(IIf(i = 1, "C1,D1,E1,F1,H1,M1,N1,O1,Q1,T1,U1,V1", "C1,D1,E1,F1,H1,K1,M1,N1,Q1,R1,S1,T1,V1")).EntireColumn.Delete
    .Columns(3).Insert
    .Cells(1, 3) = "e_mail"
    .Range("c2", .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 3)).Name = "bereik"
    If i = 1 Then
      [bereik] = [if(offset(bereik,,2)="",offset(bereik,,4),offset(bereik,,2))]
      .Range("E1,G1").EntireColumn.Delete
      .Cells(1, 5).Resize(, 5) = Array("Stad post", "Adres post", "rem_pf", "Postcode post", "First name")
    Else
      [bereik] = [if(offset(bereik,,3)="",offset(bereik,,7),offset(bereik,,3))]
      .Range("F1,J1").EntireColumn.Delete
      .Cells(1, 4).Resize(, 5) = Array("Postcode post", "Adres post", "First name", "rem_pf", "Stad post")
    End If
  End With
  Next i
   For j = 1 To 5
     Sheets.Add(, Sheets(Sheets.Count)).Name = Choose(j, "Remote maintenance", "Sold BeNL", "Sold BeFR", "Info BeNL", "Info BeFR")
   Next j
        With Sheets("Export BE").UsedRange
         .AutoFilter 1, "OK Sold"
         .Copy Sheets("Remote maintenance").Cells(1)
         .AutoFilter 7, "BEDU"
         .Copy Sheets("Sold BeNL").Cells(1)
         .AutoFilter 7, "BEFR"
         .Copy Sheets("Sold BeFR").Cells(1)
         .AutoFilter 1, "Info Request"
         .Copy Sheets("Info BEFR").Cells(1)
         .AutoFilter 7, "BEDU"
         .Copy Sheets("Info BeNL").Cells(1)
         .AutoFilter
        End With
    Sheets("Remote maintenance").Columns(2).Delete
  For Each sh In Sheets
   sh.Columns.AutoFit
  Next sh
End Sub
 
Laatst bewerkt:
Dit soort codes leer je niet even en als er al cursussen voor bestaan kost het een veel tijd en zelfstudie.
@HSV,
Code: 
For jj = 6 To 9
     .Cells(1, jj) = Choose(jj - 5, "Stad post", "Adres post", "Postcode post", "first name")
 Next jj
Toch maar eens wat lectuur inzien:d
Cells(1,6).resize(,4) = array..........
 
@VenA,
Heb je de titel van de vraag wel gelezen? :d

't Wordt tijd dat ik op bed kom. :d
 
@VenA kan je even toelichten wat je bedoeld met dat stukje formule?
 
Is al in de láátste code verwerkt.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan