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

transponeren via VBA ?

Status
Niet open voor verdere reacties.
S

STM

Gebruiker
Lid geworden
30 jan 2012
Berichten
55
Geachte,

ik krijg deze gegevens om de 3 dagen aangeleverd zoal in kolom A,
Ik moet deze gegevens transponeren naar kolom E onder elkaar dus
Het tweede probleem is dat het de ene keer 75 rijen zijn en een andere keer 135 rijen
Dit is waarschijnlijk op te lossen met VBA- waar ik onvoldoen onderleg in ben

Kan iemand helpen ??

Marnik

zie toegevoegd document zonder privé gegevens
 

Bijlagen

  • transponeren.xlsx
    9,5 KB · Weergaven: 33
Met deze macro moet het lukken

Code: 
Sub jec()
 jv = Sheets(1).Cells(1, 1).CurrentRegion
 a = Application.Max(jv)
 ReDim ar(1 To UBound(jv), 1 To a)
  
 For i = 1 To UBound(jv)
  x = (i - 1) Mod a + 1
  y = (i - 1) \ a + 1
  ar(y, x) = jv(i, 1)
 Next
 
 Sheets(1).Cells(1, 18).Resize(UBound(ar) / a, a) = ar
End Sub
 
Laatst bewerkt:
transponeren

Geachte,

Dank voor het snelle antwoord, maar helaas gebeurt er iets raar.

In het aangeleverde bestand worden de cellen gevuld in kolom R1:FZ1
tot en met R2:FZ2

Wat zou de reden daarvoor zijn? transponeren gebeurt blijkbaar niet ?

Marnik
 
gebruik a=Ubound(jv,2) ipv. a= application.max(jv)
 
Ubound(jv,2) is niet bruikbaar in dit geval
 
Zou gewoon moeten werken, heb het in het voorbeeldbestand verwerkt voor je.
 

Bijlagen

  • transponeren.xlsm
    16,3 KB · Weergaven: 14
@JVeer,
Vooropgesteld dat ik zeker niet kan tippen aan jouw VBA-kennis.:d toch een poging van mijn kant.
ene keer 75 rijen zijn en een andere keer 135 rijen
Klik om te vergroten...
Bij 135 rijen gaat het fout.
Het Voorbeeldbestand zal zeker niet representatief zijn.
Code: 
Sub jec()
Sheets(1).Cells(1, 5).CurrentRegion = ""
MsgBox "verwerken ? "

 jv = Sheets(1).Cells(1, 1).CurrentRegion
 ReDim ar(1 To UBound(jv), 1 To 11)
 
 For i = 1 To UBound(jv)
  x = (i - 1) Mod 11 + 1
  y = (i - 1) \ 11 + 1
  ar(y, x) = jv(i, 1)
 Next
 
 Sheets(1).Cells(1, 5).Resize(UBound(ar) / 11 + 1, 11) = ar
End Sub

en dan nog een vraag:
Logisch denkend was ik van mening dat dit stukje
Code: 
y = (i - 1) \ 11 + 1
ook zo kon
Code: 
y = (i - 1) / 11 + 1
niet dus, kun je het verschil eens uitleggen.
 
Hi Albert!

De 135 rijen heb ik inderdaad niet kunnen testen. Ik ben ervan uitgegaan dat de opzet hetzelfde blijft in een dergelijke situatie.

De "\" rondt het getal naar beneden af. Het is een integer operator.
Vul deze formule maar eens in ergens in je werkblad en trek naar beneden. Je ziet dat hij na 11 rijen ophoogt, wat nodig is om de array op de juiste manier te vullen.

Die "\" doet dus hetzelfde als onderstaand

Code: 
=INTEGER((RIJ(A1)-1)/11)+1
 
Laatst bewerkt:
Geachte,

Hartelijk dank aan allen die een bijdrage geleverd hebben.

Marnik
 
@JVeer,

Bedankt voor de uitleg over de \, weer wat geleerd.:thumb:
 
Laatst bewerkt:
Graag gedaan:thumb:
 
transponeren

Geachte,

Ziehier toegevoegd het gevraagde

Je kan merken wat er nu fout gaat ---=> Het subscript valt buiten het bereik

Alvast dank voor de moeite

STM
 

Bijlagen

  • transponeren_2.xlsm
    16,5 KB · Weergaven: 16
Je hebt de code achter iedere werkblad module staan. Ook de verwijzing naar de juiste sheet klopt niet.
Maak een normale module aan en zet de macro achter de knop.
Kopieer de knop naar alle sheets en het moet goedgaan.
 

Bijlagen

  • transponeren_2.xlsm
    17,8 KB · Weergaven: 24
Geachte,


Dank dit werkt perfect !!!

Ik zit nog met een tweede document maar daar werkt deze VBA natuurlijk niet wat dien ik hiervoor aan te passen.

Alvast dank bijvoorbaat

STM
 

Bijlagen

  • transponeren-DOC2.xlsx
    14,9 KB · Weergaven: 10
Hier de aanpassing met wat tekst in de code aangegeven. Hopelijk kun je het nu zelf aanpassen:thumb:
 

Bijlagen

  • transponeren-DOC2.xlsm
    24,3 KB · Weergaven: 30
Als het altijd blokken van 10 zijn werkt het goed.
Maar wat als de laatste blok valt tussen 1 en 4 aantallen.
Dit was me al eerder opgevallen en had het zo opgelost.


Code: 
With ActiveSheet.Cells(1, 5).CurrentRegion
    .ClearContents
    .Resize(UBound(ar) / 10+[COLOR="#FF0000"][B]1[/B][/COLOR], 10) = ar               'De 10 komt hier terug
 End With
Blijkbaar wordt UBound(ar) / ??? afgerond op een integer. Zelf zou ik eerder een foutmelding verwachten.
 
Klopt, er wordt afgerond binnen de Resize functie.



Code: 
Cells(1, 1).Resize(2, 3.5).Select  'naar boven afgerond

Cells(1, 1).Resize(2, 3.4).Select   'naar onder afgerond.
 
Kan toch eenvoudig met een formule?

Code: 
=INDEX($A$1:$A$200;COLUMN(A1)+(11*(ROW(A1)-1)))

Oh nu zijn het weer blokken van 10?
 
Laatst bewerkt:
Geachte,

Ik heb het ingevoegd en krijg volgende foutmelding :

origineel 11 rijen
Sub jec()
jv = ActiveSheet.Cells(1, 1).CurrentRegion
a = Application.Max(jv)
ReDim ar(1 To UBound(jv), 1 To a)

For i = 1 To UBound(jv)
x = (i - 1) Mod a + 1
y = (i - 1) \ a + 1
ar(y, x) = jv(i, 1)
Next

With ActiveSheet.Cells(1, 5).CurrentRegion
.ClearContents
.Resize(UBound(ar) / a, a) = ar
End With
End Sub

aangepast 10 rijen
Sub jec()
jv = ActiveSheet.Cells(1, 1).CurrentRegion
a = Application.Max(jv)
foutmelding ReDim ar(1 To UBound(jv), 1 To a)

For i = 1 To UBound(jv)
x = (i - 1) Mod a + 1
y = (i - 1) \ a + 1
ar(y, x) = jv(i, 1)
Next

ingevoegd With ActiveSheet.Cells(1, 5).CurrentRegion
.ClearContents
.Resize(UBound(ar) / 10 + 1, 10) = ar 'De 10 komt hier terug
End With[/B]
End Sub

wat doen ik fout ??
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan