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
Peakon-stifter går all-in og flytter til New York: ”Der er ingen grund til at tage foden af speederen”
Det danske it-selskab Peakon vil overtage verdensherredømmet. Næste stop er et kontor i New York, der åbner til sommer. "Vi forventer, at USA skal være det største marked for Peakon inden for to til tre år. Hvis USA ultimativt set skal være en succes, skal det være vores største marked," lyder målsætningen.
Computerworld
Her er Danmarks fem bedste CIO'er lige nu: Disse fem it-chefer er nomineret til titlen som Årets CIO 2018
Årets CIO 2018: Den eftertragtede titel som Årets CIO i Danmark skal snart uddeles for 13. gang af Computerworld, IDC og Dansk IT. Her er de fem nominerede til Årets CIO 2018.
CIO
Allersidste opdatering på vej: Om en uge er det slut med stor-version af Windows 10 - skynd dig at opdatere
Om en uge er det slut for altid med den første store udgave af Windows 10, som Microsoft efter 29 måneder ikke længere vil supportere.
Job & Karriere
Klassiske brokere af it-konsulenter står over for kæmpe udfordring - forretningsmodellen er under pres
Klumme: Eksterne konsulenter er populære og en god løsning i en branche i vækst. Men selve forretningsmodellen bag it-konsulenterne er under alvorligt pres.
White paper
Digitalisering i verdensklasse: Lær af finanssektorens erfaringer og nye syn på infrastruktur
Digitaliseringen buldrer afsted i erhvervslivet, men få brancher er så langt fremme som finanssektoren i bestræbelserne på digital transformation. Det har resulteret i en masse erfaringer om blandt andet hybrid infrastruktur, som andre kan drage nytte af. Læs i dette whitepaper udarbejdet af IDC for Interxion om udviklingen, den nye tankegang og de umiddelbare fordele. 12 sider på engelsk.