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 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
Wish.com er blevet en milliard-virksomhed på at sælge billigt tingel-tangel fra Kina til vestlige forbrugere: Her er forklaringen på de absurd lave priser
Hver dag lander der 40.000 pakker fra Kina i Københavs Lufthavn. For få år siden kom næsten ingen. Pakkeeksplosion skyldes blandt andet den amerikanske e-handels-sensation Wish.com, der har specialiseret sig i at sælge absurd billigt Kina-ragelse til danskerne.
Computerworld
Ny-opdaget malware blokerer programmer som forsøger at slette den: Særligt windows 10 er ramt
En ny type malware er blevet opfanget, der både overvåger din computer og generer falske reklameindtægter til bagmændende. Og så har den en forkærlighed for Windows 10.
CIO
Henrik Jeberg om at arbejde i Silicon Valley: "Er du dygtig nok får du tilbud der får en til at falde ned af stolen."
Henrik Jeberg bor i San Francisco og er direktør i Hampleton Partners, der rådgiver om opkøb med særligt fokus på teknologi. Hør ham fortælle om forskellen på Danmark og Silicon Valley - og om nogle af de vilde forhold der hersker i verdens ubestridte tech-hovedstad.
Job & Karriere
KMD opsagde tryghedsaftaler med medarbejderne få måneder før 300 medarbejdere blev outsourcet til IBM
KMD har i løbet af foråret opsagt to såkaldte tryghedsaftaler med en del af selskabets medarbejdere. Når aftalerne stopper ved udgangen af 2018, er de pågældende medarbejdere ikke længere berettiget til særlig godtgørelse. Det kan få konsekvenser, hvis IBM som forventet skærer i antallet af de 300 KMD-medarbejdere, som selskabet overtager.
White paper
Står din infrastruktur i vejen for virksomhedens udvikling? … her er de 10 vigtigste overvejelser
Oplever du, at din virksomheds it-infrastruktur er en stopklods for udviklingen af forretningen, digitalisering og konkurrencekraft? Måske er svaret hyperkonvergeret infrastruktur, hvor software og hardware smelter sammen i én konkurrencedygtig enhed, som er nem at administrere. Men der er 10 meget vigtige overvejelser at gøre sig, før man vælger en løsning. Læs dette whitepaper fra Lenovo og bliv klædt bedre på til at vælge rigtigt. 10 Key Considerations for Selecting Hyper-Converged Infrastructure - What to Know Before You Choose a Solution, Lenovo, 18 sider på engelsk.