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 Guru
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 Ekspert
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 Ekspert
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 Ekspert
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 Ekspert
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 Ekspert
22. december 2017 - 20:44 #8
Virker fint her, i hvilken linje får du fejl ?
excelent Ekspert
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 Ekspert
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 Ekspert
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 Ekspert
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





Premium
Virksomheder skrotter CFCS til overvågnings-opgave: “Det er ikke alle informationer, vi er interesseret i at dele med centeret”
Danske teleleverandører har oprettet en ny enhed til at overvåge deres netværk for mulige hackerangreb. Men enheden er bevidst blevet placeret uden for Center for Cybersikkerhed (CFCS).
CIO
Tech fra Toppen: Tim Vang får hastigheden op og de rigtige idéer frem med Googles pretotyping
Tech fra Toppen: Tim Vang får ideerne frem og hastigheden op ved konstant at tænke små overskuelige eksperimenter ind idéprocessen. Metoden hedder pretotyping og stammer fra Google. Lær meget mere om, hvordan du kan bruge værktøjet her.
Job & Karriere
Efter blodrødt regnskab: Nu fyrer Atea 20 medarbejdere i Danmark
Atea fyrer nu 20 medarbejdere. Det sker som en direkte konsekvens af, at den danske forretning er under pres, oplyser selskabets direktø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.