Redigera lista, ta bort dubletter i celler samt sammanfoga andra celler

[mr Nobody]

Hej.

 

Skulle behöva lite hjälp med behandling av en lista jag har med information om filmer.

När jag exportera listan ifrån programmet jag använde så separera den informationen från en film på flera rader.

Nu när jag ska importera listan till det nya programmet så måste all information en film stå på en rad.

Just nu är listan på över 5000 rader och när det är klart så ska det vara ca 460 rader ( filmer ). Tyvärr är det lite väl mycket att gå igenom för hand så det skulle underlätta om 

excel själv kunde klippa och klistra för att sammanställa allt. Ni kan se ett exempel på listan i bilden.

 

 

 

I de flesta fallen är det samma information som står i cellerna så där räcker det att den ena cellen raderas medans i några celler så måste informationen slås samman. 

Jag tror att lättast är att använda ett makro men tyvärr är jag inte så duktig på att skriva sådana. Som man kan se på bilden så kan man utgå ifrån kolumn A och jämföra 

cell A2 med A3, om dessa är lika skall man gå vidare till nästa kolumn och jämföra. I det här fallet så är B2 och B3 lika och man behöver inte göra något för att sen gå vidare till nästa kolumn.

När man kommer fram till H2 ( action )och jämför med H3 ( äventyr ) så är dessa olika och där skall informationen i båda cellerna sammanfogas i cellen H2 ( action, Äventyr ).

Nu kommer nog det som är knepigast, skådespelarna och deras roll. Här har jag en fundering på att göra en ny kolumn där allt sammanställs. Ta t ex J17 ( Vin ) och J18 ( Diesel ) och

J19 ( Dominic Torretto ). Denna information skall sammanfogas i cell S17 ( Vin Diesel - Dominic Torretto ) och samma sak med raden under för att man därefter sammanfoga informationen

från cell S17 och S18 så att allt hamnar i cell S17 ( Vin Diesel - Dominic Torretto, Paul Walker - Brian O'Conner, etc )

 

När man har gått över alla kolumner så skall man sen radera hela rad 3 så att alla rader under hoppar upp ett steg. Sen ska man börja om ifrån början att jämföra i kolumn efter kolumn och

sammanfoga den information som behövs.

När cell A2 och A3 inte längre stämmer överens ( första filmen är klar med all sammanställning av information samt tagit bort det som var dubletter) så skall makrot gå över att jämföra

rad 3 och rad 4 och så vidare.

 

Jag skulle uppskatta om jag fick lite hjälp med att komma igång med detta, vilka formler och så som är bäst att använda eller att någon annan har en bättre ide på hur man kan göra detta på.

Jag måste kunna spara slutresultatet som en fil så det går nog tyvärr inte att använda massor av filter och så för att det ska funka med det nya programmet.

 

Mvh Patrik

 

[mr Nobody]

Har suttit och klurat på detta problem jag har som jag beskrev tidigare. Jag vet ungefär hur flödet ska gå men det är att 

få till hur formlerna ska se ut samt så att formateringen fungerar i VBA. Jag tar även tacksamt emot tips på om man kan göra på något annat sätt som är bättre eller om jag har tänkt helt fel.

Hoppas det inte är allt för rörigt så att man kan se hur jag hade tänkt.

Här kommer flödet:

10   x=0

15   Select S2
     Sammanfoga(J2;" ";K2;" - ";L2)

16   Select T2
     Sammanfoga(M2;" ";N2)

20   IF(A3+x="tom cell";goto 500;goto 30)

30   Select A2+x
     IF(A2+x=A3+x;goto 40;goto 190)

40   Select B2+x
     IF(B2+x=B3+x; goto 50; Sammanfoga (B2+x)+(B3+x))

50   Select C2+x
     IF(C2+x=C3+x; goto 60; Sammanfoga (C2+x)+(C3+x))

60   Select D2+x
     IF(D2+x=D3+x; goto 70; Sammanfoga (D2+x)+(D3+x))

70   Select E2+x
     IF(E2+x=E3+x; goto 80; Sammanfoga (E2+x)+(E3+x))

80   Select F2+x
     IF(F2+x=F3+x; goto 90; Sammanfoga (F2+x)+(F3+x))

90   Select G2+x
     IF(G2+x=G3+x; goto 100; Sammanfoga (G2+x)+(G3+x))

100  Select H2+x
     IF(H2+x=H3+x; goto 110; Sammanfoga (H2+x)+(H3+x))

110  Select I2+x
     IF(I2+x=I3+x; goto 120; Sammanfoga (I2+x)+(I3+x))

120  Select O2+x
     IF(O2+x=O3+x; goto 130; Sammanfoga (O2+x)+(O3+x))

130  Select P2+x
     IF(P2+x=P3+x; goto 140; Sammanfoga (P2+x)+(P3+x))
140  Select Q2+x
     IF(Q2+x=Q3+x; goto 150; Sammanfoga (Q2+x)+(Q3+x))
150  Select R2+x
     IF(R2+x=R3+x; goto 160; Sammanfoga (R2+x)+(R3+x))

160  Select S3+x
     Sammanfoga(J3+x;" ";K3+x;" - ";L3+x)
     Select S2+x
     IF( S2+x=S3+x; goto 170; Sammanfoga (S2+x) + S3+x))

170  Select T3+x
     Sammanfoga (M3+x;" ";N3+x)
     Select T2+x
     IF( T2+x=T3+x; goto 180; Sammanfoga (T2+x) + T3+x))

180  Rows("x+3:x+3").Select
     Selection.Delete Shift:=xlUp
     goto 20

190  x+1
     goto 20

500  End Sub
 

[Monshi]

det ser i grunden ut som att du har en XML-fil som Excel har tolkat. kanske det finns verktyg som kan slå ihop XML så som du önskar?  Eller kan nya programmet läsa XML? Om du nu kan exportera det som korrekt XML igen?

 

 

Men men, Select och Goto. No no.

 

Se bifogad fil med ramverk du kan anpassa lite, koden ser ut som:

Sub MyConcatenator()

    Dim rnTarget As Range
    Dim rnSource As Range
    Dim rwIndex, rwStart As Integer
    rwIndex = 3
    Set rnTarget = Me.Cells(2, 10)
    rwStart = rwIndex
    While Me.Cells(rwIndex, 1) <> ""
        While (Me.Cells(rwIndex, 1) = Me.Cells(rwIndex + 1, 1))
            rwIndex = rwIndex + 1
        Wend
        Set rnSource = Me.Cells(rwStart, 1).Resize(rwIndex - rwStart + 1, 1)
        Set rnTarget = myCopy(rnTarget, rnSource)
        rwIndex = rwIndex + 1
        rwStart = rwIndex
        Set rnSource = Nothing
    Wend
End Sub

Function myCopy(rnTarget As Range, rnSource As Range)
    Dim noOfCols As Integer
    noOfCols = 4
    Dim clIndex As Integer
    Dim i, k As Integer
    Dim myStr As String
    clIndex = 1
    For clIndex = 1 To noOfCols Step 1
        If Me.Cells(1, clIndex) = "ja" Then
            For k = 1 To rnSource.Rows.Count Step 1
                myStr = myStr + rnSource.Cells(k, clIndex) + " "
            Next k
            rnTarget.Cells(1, clIndex) = Trim(myStr)
            myStr = ""
        Else
             rnTarget.Cells(1, clIndex) = rnSource.Cells(1, clIndex)
        End If
    Next clIndex
    Set myCopy = rnTarget.Offset(1)
End Function

Boken zippad eftersom den innehåller VBA-kod

VbaSnurra.zip

[mr Nobody]

6 timmar sedan, Monshi säger:

Tack för hjälpen.

Efter lite trixande så funkade det sen.