Waarden kopieren

[lvisser]

Uit een extern systeem krijg ik bijgaande data die ik wil bewerken, echter de data komt niet echt lekker in het bestand.
Per voertuig, kenteken wordt boven de data geplaatst (cel a1, a10, a24) met daaronder de regels die betrekking hebben op dat kenteken.
is het mogelijk om met vba het kenteken in kolom B per regel te krijgen?
het lukt me prima met een formule, maar ik loop er tegen aan dat het aantal regels per kenteken steeds wisselt, en ik dan de formule steeds aan moet passen ...

iemand een idee ?

 

[JEC.]

Je kan deze eens runnen

Sub jec()
 Dim ar, x, i As Long
 ar = Range("A1", Range("I" & Rows.Count).End(xlUp))
 
 For i = 1 To UBound(ar)
   If InStr(ar(i, 1), "-ABA-") Then x = ar(i, 1): ar(i, 1) = ""
   If ar(i, 1) <> "" Then ar(i, 2) = x
 Next
 
 Range("A1", Range("I" & Rows.Count).End(xlUp)) = ar
End Sub

 

[globe]

Of met een ALS formule in cel B2 en deze naar beneden en boven doortrekken.

Je moet dan wel met tekst naar kolommen kolom A naar tekst zetten:

=ALS(LENGTE(A2)<9;A2;B1)

 

[lvisser]

gaat volgens mij niet goed ...

Of met een ALS formule in cel B2 en deze naar beneden en boven doortrekken.

Je moet dan wel met tekst naar kolommen kolom A naar tekst zetten:

=ALS(LENGTE(A2)<9;A2;B1)

 

[lvisser]

Werkt prima.
echter ... kentekens zijn niet altijd in het format -ABA- .... we hebben ze in verschillende formats:
00-XXX-0 en 0-XXX-00 . waarbij de 0 een getal kan zijn tussen 0 en 9, en de X een letter tussen A en Z .. wel altijd 8 posities inclusief - teken

Je kan deze eens runnen

Sub jec()
 Dim ar, x, i As Long
 ar = Range("A1", Range("I" & Rows.Count).End(xlUp))
 
 For i = 1 To UBound(ar)
   If InStr(ar(i, 1), "-ABA-") Then x = ar(i, 1): ar(i, 1) = ""
   If ar(i, 1) <> "" Then ar(i, 2) = x
 Next
 
 Range("A1", Range("I" & Rows.Count).End(xlUp)) = ar
End Sub

 

[globe]

gaat volgens mij niet goed ...

hier wel.

heb je kolom A als tekst gezet?

 

[JEC.]

Zo dan

Sub jec()
 Dim ar, x, i As Long
 ar = Range("A1", Range("I" & Rows.Count).End(xlUp))
 
 For i = 1 To UBound(ar)
   If ar(i, 1) Like "*-*-*" And Not IsDate(ar(i, 1)) Then x = ar(i, 1): ar(i, 1) = ""
   If ar(i, 1) <> "" Then ar(i, 2) = x
 Next
 
 Range("A1", Range("I" & Rows.Count).End(xlUp)) = ar
End Sub

 

[lvisser]

Werkt nu wel, naar tekst zetten ging niet helemaal goed denk ik.

hier wel.

heb je kolom A als tekst gezet?

 

[lvisser]

Werkt ook prima! dank!

Zo dan

Sub jec()
 Dim ar, x, i As Long
 ar = Range("A1", Range("I" & Rows.Count).End(xlUp))
 
 For i = 1 To UBound(ar)
   If ar(i, 1) Like "*-*-*" And Not IsDate(ar(i, 1)) Then x = ar(i, 1): ar(i, 1) = ""
   If ar(i, 1) <> "" Then ar(i, 2) = x
 Next
 
 Range("A1", Range("I" & Rows.Count).End(xlUp)) = ar
End Sub