Avatar billede natkatten Mester
05. oktober 2012 - 12:03 Der er 4 kommentarer og
2 løsninger

VBA speciel transponering

Hej VBA-eksperten

Jeg har et regneark med ca. 3.000 rækker. Dette viser parent-child relationer ud fra nogle unikke numre.

Jeg har uploadet et eksempel på hvad jeg ønsker, idet arket "As-is", viser hvordan relationerne er pt., og "To-be" viser, hvordan jeg gerne vil have output til at være.

http://gupl.dk/685589/

Bemærk, at der altså kan være rækker uden parent-child relationer. Disse skal ikke medtages i "To-be" arket.
Avatar billede finb Ekspert
05. oktober 2012 - 15:02 #1
Jeg kan ikke få dit link til at virke ?
http://gupl.dk/685589/
mvh
finb
Avatar billede natkatten Mester
05. oktober 2012 - 15:55 #2
Hmm, det fungerer fint for mig.
Avatar billede finb Ekspert
05. oktober 2012 - 21:59 #3
Baracuda antivirus stopper vist gupl,
kan du evt vise de rå tal som txt ?
finb
Avatar billede natkatten Mester
06. oktober 2012 - 09:17 #4
Data er struktureret som vist her (kolonnerne A-Z)

ParentA 1 2 3 4
ParentB 5 6
ParentC 7 8 9 10 11 12
ParentD
ParentE 13 14

Som vist er der parents uden værdier (child).

På et andet faneblad ønsker jeg data vist i to kolonner:

ParentA 1
ParentA 2
ParentA 3
ParentA 4
ParentB 5
ParentB 6
ParentC 7
ParentC 8
ParentC 9
ParentC 10
ParentC 11
ParentC 12
ParentE 13
ParentE 14

Som det fremgår, ønsker jeg ikke, at parents uden childs vises.
Avatar billede natkatten Mester
06. oktober 2012 - 17:05 #5
Har fået løsning på anden vis.
Avatar billede natkatten Mester
06. oktober 2012 - 17:18 #6
Til info. Løsningsforslag modtaget fra Mr. Excel forum:

**********************

Option Explicit
Sub ReorgData()
' hiker95, 10/06/2012
Dim w1 As Worksheet, wR As Worksheet
Dim i As Variant, o As Variant
Dim r As Long, lr As Long, c As Long, lc As Long, n As Long, nr As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("As-is")
lr = w1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
lc = w1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
i = w1.Range(w1.Cells(1, 1), w1.Cells(lr, lc))
n = Application.CountA(w1.Range(w1.Cells(1, 2), w1.Cells(lr, lc)))
ReDim o(1 To n, 1 To 2)
nr = 0
For r = 1 To UBound(i, 1)
  For c = 2 To UBound(i, 2)
    If i(r, c) <> "" Then
      nr = nr + 1
      o(nr, 1) = i(r, 1)
      o(nr, 2) = i(r, c)
    End If
  Next c
Next r
If Not Evaluate("ISREF(To-be!A1)") Then Worksheets.Add(After:=w1).Name = "To-be"
Set wR = Worksheets("To-be")
wR.UsedRange.Clear
wR.Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
wR.Cells.EntireColumn.AutoFit
wR.Activate
Application.ScreenUpdating = True
End Sub
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester