makro til tabeloprettelse

Har du prøvet med en pivottabel?

Vil det sig at udgangspunktet er følgende:

række 1 Knr1...Knr2...Knr7...Knr9...Knr10
------2 vgr1...vgr7...vgr2..........vgr3
------3 vgr7...vgr8......................

ny tabel/Ark

kolonne.....A......B
rækk1 1....knr1...vgr1
......2....knr1...vgr7
......3....knr2...vgr7
......4....knr2...vgr8
......5....knr7...vgr2
......6....knr10..vgr3

Eller ????

Jeg vil helst ikke bruge en pivottabel ,da jeg skal bruge resultaterne videre i nogle lopslagsfunktioner. Desuden vil jeg med en pivottabel også have "blanke" linier med.

Tabellen ser således ud:
        Varegrp1  Varegrp2  varegr3 . . . . . . . .
kunde1
kunde2
kunde3
.
.
.
.

Jeg skal så lave en tabel der ser således ud:
Kunde1,varegrp1
kunde1,varegrp3
kunde2,varegrp2

Nogle kunder køber ikke fra fra alle varegrupper, og så vil jeg ikke have en record med dem.

hm.

Jeg har løst det på anden vis.

Men hvis nogen falder over dette spm. og kan lave en makro, der kan ovenstående vanker der stadig 120 point.

VH
HPO - takker supertekst og gibber for deltagelsen.

Selv tak - men jeg mener stadig at kunne skrive makroen - men har følgende spørgsmål:

Hvordan er forbindelse mellem kundenr i kolonneA og de 10 varegrp i række1  - er det et X eller?

Det er forudsat at din tabel ligger i A : K i ark4. Tilret selv området og arknavn.
Resultattabellen indsættes i Ark7 som også skal rettes til dit eget ark


Sub nytabel()
Dim nyeposter()
Worksheets("Ark4").Activate
maxrk = Range("a65536").End(xlUp).Row
poster = Range("a2:k" & maxrk)
kol = Range("iv2").End(xlToLeft).Column
rk = UBound(poster)
ReDim nyeposter(rk * kol, 1)
For i = 2 To rk
    For j = 2 To kol
        If poster(i, j) <> "" Then
        nyeposter(k, 0) = poster(i, 1)
        nyeposter(k, 1) = poster(1, j)
        k = k + 1
        End If
    Next j
Next i
Worksheets("Ark7").Range("a1:b" & UBound(nyeposter) + 1) = nyeposter
End Sub

Yderligere forudsat at dine overskrifter (varegrp.1 osv.) ligger i række 2, samt dine kundenavne i A-kolonnen

>>supertekst
Forbindelsen mellem kundenr. i kolonne A og varegrupperne i rækken er en omsætning - altså et tal.

>> Mrjh
Jeg har rettet din makro således:
Sub nytabel()
Dim nyeposter()
Worksheets("FI_kunde").Activate
maxrk = Range("a65536").End(xlUp).Row
poster = Range("a49:h" & maxrk)
kol = Range("iv2").End(xlToLeft).Column
rk = UBound(poster)
ReDim nyeposter(rk * kol, 1)
For i = 50 To rk
    For j = 2 To kol
        If poster(i, j) <> "" Then
        nyeposter(h, 0) = poster(i, 1)
        nyeposter(h, 1) = poster(1, j)
        k = k + 1
        End If
    Next j
Next i
Worksheets("Test").Range("a1:B" & UBound(nyeposter) + 1) = nyeposter
End Sub

- jeg har ikke 100% styr på makroer, men min data-tabel har ordregivere i kolonne A, men tabelhovedet med varegrupper findes i række 49, dvs. første record med data er række 50.

Jeg har lavet et nyt ark, der hedder "Test", hvor jeg i første omgang ville have indsat tabellen. Umiddelbar fungerer det ikke :(
Hvad gør jeg galt?

Den sidste kolonne jeg har med varegrupper er kolonne h.

Prøv at rette
kol = Range("iv2").End(xlToLeft).Column
til
kol = Range("iv49").End(xlToLeft).Column

og i løkken: udskift h med k, altså nyeposter(k,0) og nyeposter(k,1)

Ups ser også lige at du skal ændre:
For i = 50 To rk
til
For i = 2 To rk
Håber det var det, har ikke testet, men bare kigget koden igennem.

Det virker bedre. Jeg får bare en linje i min nye tabel - det er den nederste kunde med korrekt varegruppe - men rsten mangler.

Dette er den samlede kode som jeg tror virker. Test lige


Sub nytabel()
Dim nyeposter()
Worksheets("FI_kunde").Activate
maxrk = Range("a65536").End(xlUp).Row
kol = Range("iv49").End(xlToLeft).Column
poster = Range("a49:h" & maxrk)
rk = UBound(poster)
ReDim nyeposter(rk * kol, 1)
For i = 2 To rk
    For j = 2 To kol
        If poster(i, j) <> "" Then
        nyeposter(k, 0) = poster(i, 1)
        nyeposter(k, 1) = poster(1, j)
        k = k + 1
        End If
    Next j
Next i
Worksheets("Test").Range("a1:b" & UBound(nyeposter) + 1) = nyeposter
End Sub

http://www.eksperten.dk/spm/730686

Det funker bare mrjh.

takker mange gange.

/HPO