21. december 2017 - 12:43 Der er 14 kommentarer og
1 løsning

Data fra to rækker samlet i en

Jeg har et datasæt hvor der er tre kolonner.
Kolonne 1 og 2 holder data om produkt og variant og kolonne tre en beskrivende tekst.
Der er i rækkerne flere gengangere af samme produkt og variant, men med forskellige beskrivelser. Eksempel:
Kolonne A - B - C - (D)
10267 - 917 - ABCD
10267 - 917 - XYZ
Jeg vil gerne have dem samlet til:
10267 - 917 - ABCD - XYZ (altså ni i fire kolonner, men kun en række per produkt)
Mads32 Professor
21. december 2017 - 17:50 #1
Hej

Hvad skal der ske hvis der er flere end 1 genganger?  Skal der være flere kolonner hvis der er 2, 3 eller flere gengangere.
jens48 Guru
21. december 2017 - 19:34 #2
Jeg har lavet en lille makro, som måske kan bruges. Hvis du har dine data liggende i kolonnerne A:C vil makroen skrive de ønskede lister i området J1:T1000.

Sub Samling()
Dim LastRow, OpR, NyR, NyC, ROpslag As Integer
LastRow = ActiveSheet.UsedRange.Rows.Count
Range("J1:T1000").ClearContents
NyR = 1
For x = 1 To LastRow
If Application.WorksheetFunction.CountIf(Range("J1:J10000"), Cells(x, 1)) = 0 Then
Range(Cells(x, 1), Cells(x, 3)).Copy
Range("J" & NyR).PasteSpecial
NyR = NyR + 1
Else
If Application.WorksheetFunction.CountIf(Range("K1:K10000"), Cells(x, 2)) = 0 Then
Range(Cells(x, 1), Cells(x, 3)).Copy
Range("J" & NyR).PasteSpecial
NyR = NyR + 1
Else
ROpslag = Application.Match(Cells(x, 1).Value & " - " & Cells(x, 2).Value, Range("I1:I10000"), 0)
NyC = Application.CountA(Range(Cells(ROpslag, 10), Cells(ROpslag, 20)))
For y = 3 To 6
If Application.WorksheetFunction.CountIf(Range(Cells(ROpslag, 12), Cells(ROpslag, 20)), Cells(x, 3)) = 0 Then
Cells(ROpslag, 10 + NyC) = Cells(x, y)
NyC = NyC + 1
End If
Next
End If
End If
Next
End Sub
excelent Guru
21. december 2017 - 21:03 #3
Dine data forventes at starte i række 2 (test på en kopi)

Sub udRader()
rk = Cells(65536, "A").End(xlUp).Row

For Each c In Range("A2:A" & rk)
If c <> "" Then
  For Each d In Range("A" & c.Row + 1 & ":A" & rk)
    If d = c And c.Offset(0, 2) <> d.Offset(0, 2) Then
    x = x & "-" & d.Offset(0, 2)
      Range("A" & d.Row & ":C" & d.Row) = ""
    c.Offset(0, 3) = x
    End If
  Next
End If
x = ""
Next

Range("A2:A" & rk).SpecialCells(xlCellTypeBlanks).EntireRow.Delete Shift:=xlUp

End Sub
jens48 Guru
21. december 2017 - 21:15 #4
Der var lige en ting jeg glemte. I celle I1 og nedefter skal du skrive formelen:

=J1&" - "&K1
22. december 2017 - 11:44 #5
@Jens48 - det ser ud til at virke for rækker hvor der er data i både A og B, men hvis B er blank lægger den ikke rækkerne sammen.
Eksempel
Kolonne A - B - C - (D)
10267 - 917 - ABCD
10267 - 917 - XYZ
Bliver rigtigt nok til
10267 - 917 - ABCD - XYZ

Men hvis rækkerne i steder er
10267 - " " - ABCD
10267 - " " - XYZ
Returnere den
10267 - " " - ABCD
10267 - " " - XYZ

Har du en løsning så også de rækker med blank kolonne B men samme værdi i kolonne A bliver sammenlagt?
22. december 2017 - 11:54 #6
@excelent får følgende fejl:
Compile error:
Syntax error
jens48 Guru
22. december 2017 - 15:09 #7
Prøv med:

Sub Samling()
Dim LastRow, OpR, NyR, NyC, ROpslag As Integer
LastRow = ActiveSheet.UsedRange.Rows.Count
Range("J1:T1000").ClearContents
NyR = 1
For x = 1 To LastRow
If Application.WorksheetFunction.CountIf(Range("J1:J10000"), Cells(x, 1)) = 0 Then
Range(Cells(x, 1), Cells(x, 3)).Copy
Range("J" & NyR).PasteSpecial
NyR = NyR + 1
Else
If Cells(x, 2) = "" Then
Cells(x, 2) = " "
End If
If Application.WorksheetFunction.CountIf(Range("K1:K10000"), Cells(x, 2)) = 0 Then
Range(Cells(x, 1), Cells(x, 3)).Copy
Range("J" & NyR).PasteSpecial
NyR = NyR + 1
Else
ROpslag = Application.Match(Cells(x, 1).Value & " - " & Cells(x, 2).Value, Range("I1:I10000"), 0)
NyC = Application.CountA(Range(Cells(ROpslag, 10), Cells(ROpslag, 20)))
For y = 3 To 6
If Application.WorksheetFunction.CountIf(Range(Cells(ROpslag, 12), Cells(ROpslag, 20)), Cells(x, 3)) = 0 Then
Cells(ROpslag, 10 + NyC) = Cells(x, y)
NyC = NyC + 1
End If
Next
End If
End If
Next
End Sub
excelent Guru
22. december 2017 - 20:44 #8
Virker fint her, i hvilken linje får du fejl ?
excelent Guru
25. december 2017 - 09:12 #9
Sub udRaderII()

rk = Cells(65536, "A").End(xlUp).Row

For Each r In Range("A2:A" & rk)

If r <> "" Then
  For Each t In Range("A" & r.Row + 1 & ":A" & rk)
    If t = r And r.Offset(0, 2) <> t.Offset(0, 2) And InStr(1, r.Offset(0, 3), t.Offset(0, 2)) = 0 Then
      r.Offset(0, 3) = r.Offset(0, 3) & "-" & t.Offset(0, 2)
      End If
    If t = r Then Range("A" & t.Row & ":C" & t.Row) = ""
  Next
End If

Next

Range("A2:A" & rk).SpecialCells(xlCellTypeBlanks).EntireRow.Delete Shift:=xlUp

End Sub
27. december 2017 - 14:58 #10
@jens48 - Glædelig jul :-) Sætter stor pris på din hjælp!
Det ser ud til, at den seneste makro fejler når den rammer et felt i kolonne C som starter med et bogstav i stedet for tal. Kan det passe?
Og kan du i givet fald hjælpe mig videre?
PFT
27. december 2017 - 14:59 #11
@excelent - Glædelig jul og tak for hjælpen til dig også!
Du kan se fejlen jeg får her: https://drive.google.com/open?id=1d2JY0Jn2tRKuspfePEtr6Y-PdBd_E-va
excelent Guru
27. december 2017 - 16:06 #12
Du kan sende en kopi eller et eks på dine data hvis jeg skal prøve
excelent@gefiber.dk
jens48 Guru
27. december 2017 - 17:07 #13
Kan pt. ikke teste det. Vil gerne vende tilbage efter nytår.Godt nytår
02. januar 2018 - 13:34 #14
@jens48
Jeg oplever fortsat fejl når makroen kommer til en værdi i kolonne C der starter med et bogstav. Kan du hjælpe mig med at løse det?
Du kan eventuelt se hele mit dataark her: https://drive.google.com/open?id=1rgOnwbQx17laQ269NNdJO7nbof3GQcK2
Første gang jeg løber på fejlen er når A har værdi 10039.
jens48 Guru
03. januar 2018 - 22:31 #15
Jeg har noget, som måske kan bruges, men jeg har problemer med dit dataark. Kan du ikke uploade et excel ark i stedet for en CSV fil.
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

Opret Preview

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





Computerworld
Med ny iOS-opdatering vil du selv kunne slå udskældt batterifunktion fra på din iPhone
Apple har sænket ydeevnen på ældre iPhones for at få batteriet til at holde længere, men nu fortæller Tim Cook, at du i fremtiden selv kan slå funktionen fra.
CIO
Opråb til ERP-leverandørerne: Stram op - I opfører jer uanstændigt
Klumme: Hvorfor kan ERP-projekter ikke leveres til fastpris ligesom andre systemer? Hvordan kan ERP-leverandørerne slippe afsted med at opføre sig uanstændigt? ERP-leverandørerne har et alvorligt problem og er nødt til at gøre det bedre. Se nogle af mine vilde eksempler fra den danske it-branche her.
Comon
LG stopper al udvikling af LG G7: Begynder helt forfra få måneder før lancering
Ifølge et velanset koreansk investormedie har LG’s CEO beordret fuld stop på udviklingen af LG G7 og starte forfra
Job & Karriere
Dansk it-virksomhed indførte fire-dages arbejdsuge: I dag er sygefraværet rekord-lavt og direktøren har tabt sig 13 kilo
Interview: Great Place To Work kategori-vinderen IIH Nordic har indført en fire-dages arbejdsuge og taget et opgør med forstyrrende storrums-kontorer og en frustrerende mailkultur. I dag er medarbejderne gladere end nogensinde før.
White paper
Mobility - her er de aktuelle udfordringer
Hvad med sikkerheden? Mobility-bølgen fejer igennem danske virksomheder, og der er masser af muligheder og faldgruber. Sikkerheden halter, men det kan der gøres noget ved. Produceret af Computerworld.dk i oktober 2014.