26. august 2013 - 10:10Der er
12 kommentarer og 1 løsning
Samle flere kolonner i én (dog ikke med & tegn kommandoen)
Jeg har en mængde data i flere kolonner i Excel som jeg ønsker at samle i én kolonne. Det jeg har brug for at gøre er IKKE at kombinere data fra flere kolonner som man gør ved f.eks. at skrive =A1&B1 men derimod har jeg brug for at samle data fra f.eks. tre rækker i tre kolonner til en enkelt kolonne med ni rækker.
Når jeg f.eks. har data i felterne A1, A2, A3 og B1, B2, B3 og C1, C2, C3 ønsker jeg at dataene fra B og C kolonnerne vises fortløbende under A kolonnen, således at data fra disse ni felter vises i A1, A2, A3, A4, A5, A6, A7, A8 og A9.
I princip er rækkefølgen ligegyldig, det vigtige er at samle alle data i én kolonne.
Antallet af kolonner og rækker i kolonnerne kan godt variere.
Jeg er ikke synderligt god til visual basic, og det er også begrænset hvor ofte jeg har brug for at samle kolonner, så jeg ser ikka vba som en mulighed.
Højreklik på relevante ark / Vis programkode / Indsæt nedenstående Luk VBA-vindue Alt+F8 - marker samlingAfKolonner - Afspil
Dim antalKol As Integer, antalRæk As Long Dim ræk As Long, kol As Integer, værdi, nyRæk As Long Public Sub samlingAfKolonner() antalKol = ActiveCell.SpecialCells(xlLastCell).Column antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
Rem find første ledige celle i kol A nyRæk = findFørsteLedigeKolA
For kol = 2 To antalKol For ræk = 1 To antalRæk Cells(ræk, kol).Select værdi = Selection.Value If værdi <> "" Then Selection.ClearContents Cells(nyRæk, 1) = værdi nyRæk = nyRæk + 1 End If Next ræk Next kol End Sub Private Function findFørsteLedigeKolA() Dim ræk As Long For ræk = 1 To antalRæk If Range("A" & ræk) = "" Then findFørsteLedigeKolA = ræk Exit Function End If Next ræk End Function
Hej supertekst Det er helt vildt pænt af dig at skrive koden til mig, nu kan jeg så sidde tilbage og skamme mig. Skamme mig over at jeg har glemt at fortælle at jeg kun har en engelsk udgave af excel, og som sagt er jeg ikke supergod til VBA og jeg kan derfor ikke oversætte koden til engelsk så jeg kan bruge den, jeg er jo godt klar over at den mindste fejl i koden vil gøre den ubrugelig. :-(
Ok, jeg havde faktisk prøvet at indsætte koden, dog uden held, så jeg antog at det var et sprogligt problem.
Jeg har nu prøvet igen, og har lavet et testregneark hvor jeg blot har skrevet a1, a2, a3, b1, b2, b3, c1, c2, c3 i netop disse felter, og så skulle teksten b1 gerne havne i feltet a4, og teksten b2 i feltet a5 o.s.v. Dette sker dog ikke, jeg får stadig en fejlmeddelelse, desværre en fejlmeddelelse der ikke siger særlig meget.
Når jeg kører makroen får jeg straks en popup med overskriften Microsoft Visual Basic, og i vinduet står der ikke andet end "400" sammen med en rød cirkel med et kryds som naturligvis illustrerer at der er sket en fejl. Når jeg lukker dette vindue er førstkommende data som skulle flyttes forsvundet, d.v.s. teksten b1 som er skrevet i feltet b1. Kører jeg makroen igen får jeg samme fejl, og når jeg lukker popup vinduet er næstkommende data forsvundet, d.v.s. teksten b2 som er skrevet i feltet b2, og sådan fortsætter det indtil teksten c3 i feltet c3 er væk. Ingen af teksterne kopieres, de forsvinder blot én af gangen.
Jeg har sendt dig filen, det er pænt af dig at hjælpe, men er løsningen ikke ligetil så lader vi problemet ligge her, så må jeg blot flytte kolonner manuelt, det kan selvfølgelig lade sig gøre, det er blot lidt tidskrævende.
Dim antalKol As Integer, antalRæk As Long Dim ræk As Long, kol As Integer, værdi, nyRæk As Long Public Sub samlingAfKolonner() antalKol = ActiveCell.SpecialCells(xlLastCell).Column antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
Rem find første ledige celle i kol A nyRæk = findFørsteLedigeKolA
For kol = 2 To antalKol For ræk = 1 To antalRæk Cells(ræk, kol).Select værdi = Selection.Value If værdi <> "" Then Selection.ClearContents Cells(nyRæk, 1) = værdi nyRæk = nyRæk + 1 End If Next ræk Next kol End Sub Private Function findFørsteLedigeKolA() Dim ræk As Long For ræk = 1 To antalRæk If Range("A" & ræk) = "" Then findFørsteLedigeKolA = ræk Exit Function End If Next ræk findFørsteLedigeKolA = antalRæk + 1 End Function
Synes godt om
1 synes godt om dette
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
