Avatar billede lassel Nybegynder
27. marts 2009 - 09:42 Der er 4 kommentarer og
1 løsning

Excel macro konverter linier til flere linier afhængig af værdi i oprindelige linier

Hej eksperter,

Jeg har forsøgt lidt frem og tilbage men uden held og tror jeg behøver en skræddersyet VBA macro :(

Er det muligt at lave en macro der kan konvertere følgende array fra linier med værdier fra 1 og opefter i sidste kolonne én lang list af linier med værdien 1 i hver, jeg illustrerer input:

col.text1    col.text2    col.text3    Qty
A1    B1    C1    2
A1    B1    C2    2
A1    B1    C3    1
A1    B1    C4    3
A2    B2    C2    1
A2    B2    C4    3
A2    B2    C8    1
A3    B3    C7    4
A3    B3    C9    2

fange hver linie, se i kolonne Qty, hvis over en kopiere linien og indsætte antal gang som der er Qty mens Qty for hver af disse linier ændres til 1... dvs. output:

col.text1    col.text2    col.text3    Qty
A1    B1    C1    1
A1    B1    C1    1
A1    B1    C2    1
A1    B1    C2    1
A1    B1    C3    1
A1    B1    C4    1
A1    B1    C4    1
A1    B1    C4    1
A2    B2    C2    1
A2    B2    C4    1
A2    B2    C4    1
A2    B2    C4    1
A2    B2    C8    1
A3    B3    C7    1
A3    B3    C7    1
A3    B3    C7    1
A3    B3    C7    1
A3    B3    C9    1
A3    B3    C9    1

Jeg ved ikke om dette overhovedet er muligt og hvor svært det er , vil tro det er svært så sætter som udgangspunkt 60 point?
Avatar billede mikker Nybegynder
27. marts 2009 - 12:07 #1
Den hurtige:

Sub qty()
xllin = 2
Do While Trim(Sheets("Ark1").Range("A" & xllin)) <> ""
If Sheets("Ark1").Range("D" & xllin) > 1 Then
nylin = Sheets("Ark1").Range("D" & xllin)
Sheets("Ark1").Range("D" & xllin) = 1
Sheets("Ark1").Range("A" & xllin & ":D" & xllin).Copy
    Sheets("Ark1").Range("A" & (xllin + 1) & ":A" & (xllin + nylin)).Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
xllin = xllin + nylin
nylin = 0
End If
xllin = xllin + 1
Loop
End Sub
Avatar billede lassel Nybegynder
27. marts 2009 - 12:43 #2
Tusind tak for hurtig svar, dog har jeg en lille fejl jeg ikke kan grejle hvorfor, output giver en linie for meget for alle linier der havde Qty over 1:

Sub Macro1()
xllin = 2
Do While Trim(Sheets("Sheet1").Range("A" & xllin)) <> ""
If Sheets("Sheet1").Range("D" & xllin) > 1 Then
nylin = Sheets("Sheet1").Range("D" & xllin)
Sheets("Sheet1").Range("D" & xllin) = 1
Sheets("Sheet1").Range("A" & xllin & ":D" & xllin).Copy
    Sheets("Sheet1").Range("A" & (xllin + 1) & ":A" & (xllin + nylin)).Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
xllin = xllin + nylin
nylin = 0
End If
xllin = xllin + 1
Loop
End Sub

For eksempel så får denne korrekt:
Input
A1    B1    C3    1
Output
A1    B1    C3    1

Men med mere end 1:
Input
A1    B1    C1    2
Output
A1    B1    C1    1
A1    B1    C1    1
A1    B1    C1    1

Der skulle kun være 2 linier i output... har det noget med Sheets("Sheet1").Range("A" & xllin & ":D" & xllin).Copy der skal have D - 1?
Avatar billede mikker Nybegynder
28. marts 2009 - 05:01 #3
Det er fordi jeg så har misforstået opgaven.
Når du skriver "hvis over en kopiere linien og indsætte antal gang som der er Qty" indsætter jeg jo 2 når der står Qty=2 Du vil have indsat Qty-1.

Prøv

nylin = Sheets("Sheet1").Range("D" & xllin)-1

Og evt.

xllin = xllin + (nylin-1)
Avatar billede lassel Nybegynder
28. marts 2009 - 16:08 #4
Ahhh, det beeklager jeg meget, at jeg ikke beskrev problemet tydeligere!! :D

Det virker perfekt, du skal have tusinde tak for hjælpen.
Avatar billede mikker Nybegynder
29. marts 2009 - 06:19 #5
Altid rart at kunne hjælpe.
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
Kurser inden for grundlæggende programmering

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