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

van rijen naar kolommen in ander tabblad

Status
Niet open voor verdere reacties.
J

jansm

Gebruiker
Lid geworden
2 apr 2014
Berichten
421
Ik zou heel graag de in rijen geplaatste gegevens (rij B4:B10, B13:B19 enz.) in “DATA” (oorspronkelijk > 50.000 regels) verzameld willen zien in de tabel van tabblad “RESULT” (D7:J7 enz.). Wilt iemand me daarbij willen helpen?Bekijk bijlage TEST_1.xlsb
 
Laatst bewerkt:
Zweeft het allemaal zo of staat de data normaal gesproken vanaf A1 en moet dan getransponeerd worden naar A1 op het andere blad?

De functies RIJ(), KOLOM(), ADRES(), VERSCHUIVING() en INDIRECT() zou je eens kunnen bestuderen.
 
Een beetje op weg geholpen.
 

Bijlagen

  • TEST_cobbe.xlsb
    25,1 KB · Weergaven: 38
bedankt voor jullie reactie.
Start rij van "DATA" is te kiezen natuurlijk maar de cel met "read more..." en de blanco cell die zitten er standaard tussen. Het plaatsen mag van mij beginnen in A1. Ga straks naar jullie suggesties kijken.
 
Andere methode: zonder loop.

Code: 
Sub hsv()
Dim sn
 Sheets("data").Range("b4", Sheets("data").Cells(Rows.Count, 2).End(xlUp)).Name = "bereik"
 sn = Split(Join([transpose(bereik)], vbCr), String(2, vbCr))
   Sheets("result").Cells(2, 1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
    Application.DisplayAlerts = False
     Sheets("result").Columns(1).SpecialCells(2).Offset(1).SpecialCells(2).TextToColumns , , , , 0, 0, 0, 0, -1, vbCr
    Application.DisplayAlerts = True
    Application.Names("bereik").Delete
End Sub
 

Bijlagen

  • hsv-code.xlsb
    26,2 KB · Weergaven: 23
Laatst bewerkt:
Cobbe, aan jouw code moet e.e.a. nog aangepast worden (telwerk) zo als je zelf ook aangeef. Code van hsv werkt. Alleen hsv, moet ik nog af zien te komen van de termen voornamen, geslacht enz.. Ik kan het tabblad DATA wel bewerken met een formule om dit te verwijderen maar kan dat ook simpel in jouw code gedaan worden?
 
het verwijderen van die termen kan met 1 simpele zoek en vervang actie.

zet in zoeken vak "*: "
laat vervangen vak leeg en kies "Alles vervangen"

zoekterm is dus: sterretje, dubbele punt en spatie (de aanhalingstekens niet tikken)
vergeet de spatie niet achter de dubbele punt want anders staat voor al je waarden een spatie.

normaal zou ik een tekst naar kolommen actie adviseren omdat dat ietsjet veiliger is omdat er niets verwijderd wor maar omdat er bij achternamen geen voorvoegsel is krijg je als je dat hier wordt de benodigde data in 2 kolomman.
 
Laatst bewerkt:
Maar met een formule lukt het ook wel. gebruik deze formule in kolom C

Code: 
=ALS.FOUT(DEEL(B4;VIND.SPEC(":";B4)+2;LENGTE(B4)-VIND.SPEC(":";B4));B4)
 
dag Roel, bedankt. Werkt, maar nu wordt in de blanco cel (tussen de records) een 0 geplaatst. Hier kan de code van hsv niet mee over weg. Ik vermoed dat het in de komma's en 0-en van deze regel zit

Code: 
Sheets("result").Columns(1).SpecialCells(2).Offset(1).SpecialCells(2).TextToColumns , , , , 0, 0, 0, 0, -1, vbCr
Heb al wel een beetje gerommeld hiermee maar dat lukt me niet.
 
even zo uit het blote hoofd zonder test.

Code: 
=ALS.FOUT(DEEL(B4;VIND.SPEC(":";B4)+2;LENGTE(B4)-VIND.SPEC(":";B4));[COLOR="#0000FF"]als(isleeg(B4);"";B4)[/COLOR])

met die extra als test zou een lege cel leeg gelaten worden en komt er geen 0 meer.
 
Wel met een loopje maar de laatste regel kan je ook gebruiken in combinatie met de code van HSV

Code: 
Sub VenA()
  For Each ar In Sheets("DATA").Columns(2).SpecialCells(2).Areas
    Sheets("RESULT").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, ar.Rows.Count) = Application.Transpose(ar)
  Next ar
  Sheets("RESULT").Cells(1).CurrentRegion.Replace "*: ", ""
End Sub
 

Bijlagen

  • TEST.xlsb
    18,6 KB · Weergaven: 24
Dit zal beter werken.
Code: 
Sheets("RESULT").Cells(1).CurrentRegion.Replace "*:", "", 2, , -1


ps:

de ,, -1 kan weggelaten worden.
 
Laatst bewerkt:
werkt idd beter Harry. Ik wilde net reageren op posting van VenA omdat bij sommige datums mm en dd werden verwisseld. Ook als er een datum of plaats in tabblad "DATA" ontbrak dan was het resultaat ook niet goed. Bij die van jou is het probleem opgelost (wat ik tot nu toe gezien heb).

Roel, VenA en Harry bedankt. Dit is hem geworden

Code: 
Sub hsv()
Dim sn

With Sheets("DATA")
      .Columns(2).NumberFormat = "@"
End With

 Sheets("data").Range("b4", Sheets("data").Cells(Rows.Count, 2).End(xlUp)).Name = "bereik"
 sn = Split(Join([transpose(bereik)], vbCr), String(2, vbCr))
   Sheets("result").Cells(2, 1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
    Application.DisplayAlerts = False
     Sheets("result").Columns(1).SpecialCells(2).Offset(1).SpecialCells(2).TextToColumns , , , , 0, 0, 0, 0, -1, vbCr
    Application.DisplayAlerts = True
    Application.Names("bereik").Delete
   ' Sheets("RESULT").Cells(1).CurrentRegion.Replace "*: ", "" 'ex VenA
  Sheets("RESULT").Cells(1).CurrentRegion.Replace "*:", "", 2, , -1 'ex HSV
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan