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
Afsløring: KMD kalder det "ny viden" - men selskabet har kendt til problematisk udflytning af persondata siden 2014
KMD har hidtil fastholdt, at det har været "ny viden" for selskabet, at følsomme persondata fra landets jobcentre ikke må sendes ud af landet. En SKI-aftale viser dog, at KMD har kendt til reglerne siden 2014. "Selv i det omfang, at KMD ikke har haft de fornødne juridiske kompetencer, burde alle advarselslamper da have blinket i forhold til teksten i SKI-aftalen," lyder det fra juridisk ekspert.
Computerworld
Google indfører Android-gebyr efter kæmpe EU-bøde: Android-producenter skal nu betale for brug af Google-tjenester
Efter sommerens kæmpe EU-bøde indfører Google licensbetaling for Android-producenters brug af blandt andet Play Store. Men "Android vil forblive gratis og open source," lyder det fra selskabet.
CIO
Forleden reparerede en mekaniker min bil: Det kostede 4.200 kroner, som min hjerne snød mig til at betale med et smil
De rationelle it-beslutninger du træffer er måske en illusion. Det lærte jeg da min bil gik i stykker og min hjerne snød mig til at tro, at alt var fint. Til gengæld fandt jeg tre fælder dine it-beslutninger kan falde i.
Job & Karriere
Her er syv job-annoncer der overrasker med helt usædvanlige overskrifter
Der er mange ledige it-job i øjeblikket. It-jobbank har her fundet syv spændende stillinger, der har det til fælles, at annoncen har en utraditionel overskrift.
White paper
Test jeres it-sikkerhed gratis i 14 dage med Cisco Stealthwatch - og få rapport med resultaterne direkte i din indbakke
Du kan nu - kvit og frit - teste banebrydende it-sikkerhedsløsninger fra Cisco. Cisco Stealthwatch holder øje med trafikken på dit netværk. Den danner et normalbillede af trafikken og giver dig en advarsel, så snart der sker afvigelser, herunder trafik til og fra printere, laptop-kameraer og lignende, som ikke kan beskyttes med klassisk antivirus-software. Efter 14 dage modtager du en rapport direkte i din indbakke med et samlet overblik over opfangede trusler og et helhedsbillede af adfærden på dit netværk. Når du booker en trial, registrerer vi dig i vores system og retter henvendelse til dig via en af vores partnere inden for ganske få dage. Trialløsningen er enkel at installere og kræver ingen ny hardware.