25. juli 2012 - 15:23
Der er
3 kommentarer og
1 løsning
Transponer kolonne til rækker
Hej
Lad mig starte med at sige, at jeg ikke er VBA ekspert, derfor vil jeg sætte pris, på så meget forklaring som muligt. Så jeg kan forstå det bedst muligt.
Det jeg skal bruge hjælp til er en makro i excel der kan opdele en kolonne i flere antal rækker, alt efter hvor mange der er.
Jeg har forneden forsøgt at lave et forsimplet eksempel, hvor makroen skal opdele og fordele ordrene i en række ud fra Kunde id'et.
Håber virkeligt der er en der kan hjælpe mig, har søgt alle steder på nettet, men synes ikke jeg kan finde nogen i lignende situation:(
Nuværende situation:
Kunde ID: Adresse: Ordre:
123 Vestergade 10, 2100 København Ø ABX
212 Østergade 3, 8000 Århus C NNA
124 Nøregade 7, 5200 Odense V VVY
123 Vestergade 10, København NNA
Ønsket situation:
Kunde ID: Adresse: Ordre: Ordre2:
123 Vestergade 10, 2100 København Ø ABX NNA
212 Østergade 3, 8000 Århus C NNA
124 Nøregade 7, 5200 Odense V VVY
Rem VBA-kode anbringes under det aktuelle ark (Højreklik på ark / Vis programkode / Indsæt VBAKode her
Rem Koden kan eksekveres med Alt+F8 / Marker samlingAfOrdre / Afspil
Rem ================================================================
Dim sidsteRække As Long, ræk As Long
Dim kundeId As Variant, kundeRække As Long
Dim ræk2 As Long
Public Sub samlingAfOrdre()
Rem Beregn sidste række
sidsteRække = ActiveCell.SpecialCells(xlLastCell).Row
ræk2 = 2
Rem Traverser rækkerne
For ræk = 2 To sidsteRække
kundeId = Range("A" & ræk)
ordre = Range("C" & ræk)
Rem findes kundeid i ny tabel
kundeRække = findesKunde(kundeId)
If kundeRække = 0 Then
Rem Opret kundedata
opretKundeData
Else
indsætNyOrdre kundeRække, ordre
End If
Next ræk
Rem tilpas kolonnebredde
Columns.AutoFit
End Sub
Private Function findesKunde(kundeId)
Dim r As Long
For r = 2 To sidsteRække
If Range("E" & r) = kundeId Then
findesKunde = r
Exit Function
End If
Next r
findesKunde = 0
End Function
Private Sub opretKundeData()
Range("E" & ræk2) = Range("A" & ræk)
Range("F" & ræk2) = Range("B" & ræk)
Range("G" & ræk2) = Range("C" & ræk)
ræk2 = ræk2 + 1
End Sub
Private Sub indsætNyOrdre(række, ordre)
Dim kolonne As Integer
Rem find celle til ny ordre på eksisterendekundedata
For kolonne = 8 To 16384
If Cells(række, kolonne) = "" Then
Cells(række, kolonne) = ordre
Exit Sub
End If
Next kolonne
End Sub
