Du må være registrert og logget inn for å kunne legge ut innlegg på freak.no
X
LOGG INN
... eller du kan registrere deg nå
Dette nettstedet er avhengig av annonseinntekter for å holde driften og videre utvikling igang. Vi liker ikke reklame heller, men alternativene er ikke mange. Vær snill å vurder å slå av annonseblokkering, eller å abonnere på en reklamefri utgave av nettstedet.
  11 5121
Nok en gang trenger jeg hjelp til en fiffig formel i Excel.



De to første kolonnene er hva jeg har, kolonne C er hva jeg ønsker å oppnå.

Altså:
Det vil være rekker med løpende tall, med vilkårlig lengde og vilkårlige avbrudd (har illustrert celler uten verdi med «-»), disse har ulike farger som må samles på raden til nr. 1.

Er dette mulig å få til med en snasen formel?

Tilleggsopplysning: Per nå har ikke 1, 2, 3 osv. noe unikt per tallrekke, som kunne fungert som en videre oppdeling.

Har lastet opp utgangspunktet på denne lenka.
Men utgangspunkt er alltid at det er tre tall på rad som hører sammen? Og i cellene med avbrudd er det ikke tallverdier?

Gitt at det er tilfelle skal dette fungere:

Kode

Dim tempString As String
For i = 1 To 1000
    tempString = ""
    If IsNumeric(Cells(i, 1)) Then
        If Not Cells(i, 1).Value = Null Then
            For j = i To i + 2
                tempString = tempString & Cells(j, 2).Value & "|"
            Next j
            Cells(i, 3).Value = Mid(tempString, 1, Len(tempString) - 1)
            i = i + 2
        End If
    End If
Next i
http://i.imgur.com/whpCoi6.png
Sist endret av lroedal; 21. mars 2017 kl. 15:16. Grunn: Automatisk sammenslåing med etterfølgende innlegg.
jamen yolo da.
Viva la Opium's Avatar
Trådstarter
Nei og ja.

Det er vilkårlig hvor mange tall som er i en rekke, alt fra 1, 2 til 1, 2 […] 41, 42, og det er vilkårlig om de starter rett etter hverandre, eller om det er celler uten tallverdi mellom.


Kom på at problemstillingen ligner litt på hjelp jeg har mottatt tidligere, forskjellen er at jeg må samle flere verdier.
Så eneste måte å vite at neste rekke starter på er å sjekke om det ikke er en tallverdi i kolonne A og/eller at det er en fargeverdi i kolonne B da?

Skrev fortsatt feil, og fikk ikke endret - haha. Men er det noe annet som tilsier at det er snakk om en ny tallrekke enn mangel på tallverdi i kolonne A? Burde ikke være så vanskelig å ordne formel for dette, men man må jo ha noe å sjekke etter.
Sist endret av lroedal; 21. mars 2017 kl. 15:29. Grunn: Automatisk sammenslåing med etterfølgende innlegg.
jamen yolo da.
Viva la Opium's Avatar
Trådstarter
Stemmer, så vidt jeg kan se (i resten av dokumentet) er det ikke noe annet som skiller av hver tallrekke (slik som det er i den siste lenka jeg postet).

Slik det er nå er hver tallrekke (eller mangelen på tall) enten et produkt, eller en variant av et produkt. Dvs. enten er produktet en drill (ingen tall), eller så er det en genser, som igjen kan være en farge. Genseren med farge må importeres i to omganger, først bare «foreldreproduktet» (som er nr. 1) som forteller om de ulike variantene i kolonne C, og deretter variantene (som er 1, 2, 3 osv.).

Derfor er alt relatert til de ulike variantene alltid forskjellig, produktnavnene, artikkelnummer, bildenavn etc., eventuelt er de tingene som kunne blitt brukt til å skille de av like, f.eks. kategorier, leverandør etc.

Liker at utdypningene mine som skal gjøre det lettere å forstå mest sannsynlig gjør det vanskeligere.

Om det er umulig uten en måte å gruppere produktene på tar jeg gjerne i mot en løsning med gruppering, så får heller noen gjøre den kjipe jobben slik at det funker.

Edit: Da har jeg fått til at hver tallrekke får et unikt navn, har oppdatert eksempelfila.
Sist endret av Viva la Opium; 22. mars 2017 kl. 11:04. Grunn: Automatisk sammenslåing med etterfølgende innlegg.
I see you...
NAPse's Avatar
VBA:

Kode

Option Explicit

Public Function JoinText(cells As Variant, Optional delim_str As String) As String
    If cells.Columns.Count < cells.Rows.Count Then
       JoinText = Join(WorksheetFunction.Transpose(cells), delim_str)
    Else
       JoinText = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(cells)), delim_str)
    End If
End Function
Kolonne D norsk og engelsk:

Kode

=HVIS(B2=1, JoinText(C2:INDIREKTE("C"&SAMMENLIGNE(A2,A:A,1)),"|"), "")

Kode

=IF(B2=1, JoinText(C2:INDIRECT("C"&MATCH(A2,A:A,1)),"|"), "")
jamen yolo da.
Viva la Opium's Avatar
Trådstarter
Den løsningen ser ut til å funke som den skal, fantastisk!
jamen yolo da.
Viva la Opium's Avatar
Trådstarter
Ny utfordring, som bygger videre på denne. Den flotte løsningen som funker fint gir meg et problem jeg ikke umiddelbart tenkte over.

For løsningen som skal benytte fila funker det ikke om hver farge listes opp flere ganger (altså: Rød|Blå|Grønn|Rød|Blå|Grønn), derfor må de duplikate fargene fjernes fra hver tallrekke.

Har satt opp en eksempelfil på denne lenka, som viser hva jeg tenker og ønsker å oppnå.

Løsningen til venstre er vel det enkleste, at man rydder opp i lista før de samles i én celle, kontra at de samles også ryddes opp i?

For å oppsummere / overforklare:

Jeg trenger bare de unike verdiene for C, før de samles i E (merk at hvis cellene er blanke slik som i D vil det bli blanke resultater som ødelegger i E, f.eks. Rød|Blå|Grønn|||).
Sist endret av Viva la Opium; 28. mars 2017 kl. 12:56.
I see you...
NAPse's Avatar
Legg til:

Kode

Function RemoveDupes(txt As String, Optional delim As String) As String
    Dim x
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For Each x In Split(txt, delim)
            If Trim(x) <> "" And Not .exists(Trim(x)) Then .Add Trim(x), Nothing
        Next
        If .Count > 0 Then RemoveDupes = Join(.keys, delim)
    End With
End Function
Ny formel:

Kode

=RemoveDupes(IF(B2=1, JoinText(C2:INDIRECT("C"&MATCH(A2,A:A,1)),"|"), ""),"|")
Oops, her er en bedre formel som ikke kaller på RemoveDupes() uansett utfall

Kode

=IF(B2=1, RemoveDupes(JoinText(C2:INDIRECT("C"&MATCH(A2,A:A,1)),"|"), "|"),"")
Sist endret av NAPse; 28. mars 2017 kl. 13:47. Grunn: Automatisk sammenslåing med etterfølgende innlegg.
jamen yolo da.
Viva la Opium's Avatar
Trådstarter
Har nå forsøkt på flere forskjellige maskiner og versjoner av Excel, ser ikke ut til overnevnte kode funker på Mac-er. Får ikke noe feilmelding på formelen, så mistenker at det er noe med koden.
I see you...
NAPse's Avatar
Det ser ut til at CreateObject() ikke eksisterer i mac universet.

Edit:
Problemet var at "Scripting.Dictionary" bruker en dll fil fra windows.

Men det finnes jo selvsagt en dyktig sjel der ute som har laget en løsning.

Regneark eksempel

Koder:
SPOILER ALERT! Vis spoiler

VBA script

Kode

Option Explicit

Public Function JoinText(cells As Variant, Optional delim_str As String) As String
    If cells.Columns.Count < cells.Rows.Count Then
       JoinText = Join(WorksheetFunction.Transpose(cells), delim_str)
    Else
       JoinText = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(cells)), delim_str)
    End If
End Function

Function RemoveDupes(txt As String, Optional delim As String) As String
    Dim y
    Dim x As Dictionary
    Set x = New Dictionary
    For Each y In Split(txt, delim)
        If Trim(y) <> "" And Not x.Exists(Trim(y)) Then x.Add Trim(y), Nothing
    Next
        If x.Count > 0 Then RemoveDupes = Join(x.Keys, delim)
End Function
Dictionary.cls

Kode

Option Explicit

'Collection methods: Add, Count, Item, Remove
'Dictionary : .Add(Key as string, Item as variant), .CompareMode, .Count, .Exists(Key); _
   .Item(Key) - writeable, .Items, .Keys, .Remove(Key), .RemoveAll
'plus KeyValuePairs collection, KeyValuePair(Index as long), Tag as variant
' 25-11-2011 KeyValuePair helper object

Public KeyValuePairs As Collection ' open access but allows iteration
Public Tag As Variant            ' read/write unrestricted

Private Sub Class_Initialize()
   Set KeyValuePairs = New Collection
End Sub

Private Sub Class_Terminate()
   Set KeyValuePairs = Nothing
End Sub

' in Scripting.Dictionary this is writeable, here we have only vbtextCompare because we are using a Collection
Public Property Get CompareMode() As VbCompareMethod
   CompareMode = vbTextCompare   '=1; vbBinaryCompare=0
End Property

Public Property Let Item(Key As String, Item As Variant)    ' dic.Item(Key) = value ' update a scalar value for an existing key
   Let KeyValuePairs.Item(Key).value = Item
End Property

Public Property Set Item(Key As String, Item As Variant)    ' Set dic.Item(Key) = value ' update an object value for an existing key
   Set KeyValuePairs.Item(Key).value = Item
End Property

Public Property Get Item(Key As String) As Variant
   AssignVariable Item, KeyValuePairs.Item(Key).value
End Property

' Collection parameter order is Add(Item,Key); Dictionary is Add(Key,Item) so always used named arguments
Public Sub Add(Key As String, Item As Variant)
   Dim oKVP As KeyValuePair
   Set oKVP = New KeyValuePair
   oKVP.Key = Key
   If IsObject(Item) Then
      Set oKVP.value = Item
   Else
      Let oKVP.value = Item
   End If
   KeyValuePairs.Add Item:=oKVP, Key:=Key
End Sub

Public Property Get Exists(Key As String) As Boolean
   On Error Resume Next
   Exists = TypeName(KeyValuePairs.Item(Key)) > ""  ' we can have blank key, empty item
End Property

Public Sub Remove(Key As String)
   'show error if not there rather than On Error Resume Next
   KeyValuePairs.Remove Key
End Sub

Public Sub RemoveAll()
   Set KeyValuePairs = Nothing
   Set KeyValuePairs = New Collection
End Sub

Public Property Get Count() As Long
   Count = KeyValuePairs.Count
End Property

Public Property Get Items() As Variant     ' for compatibility with Scripting.Dictionary
Dim vlist As Variant, i As Long
If Me.Count > 0 Then
   ReDim vlist(0 To Me.Count - 1) ' to get a 0-based array same as scripting.dictionary
   For i = LBound(vlist) To UBound(vlist)
      AssignVariable vlist(i), KeyValuePairs.Item(1 + i).value ' could be scalar or array or object
   Next i
   Items = vlist
End If
End Property

Public Property Get Keys() As String()
Dim vlist() As String, i As Long
If Me.Count > 0 Then
   ReDim vlist(0 To Me.Count - 1)
   For i = LBound(vlist) To UBound(vlist)
      vlist(i) = KeyValuePairs.Item(1 + i).Key   '
   Next i
   Keys = vlist
End If
End Property

Public Property Get KeyValuePair(Index As Long) As Variant  ' returns KeyValuePair object
    Set KeyValuePair = KeyValuePairs.Item(1 + Index)            ' collections are 1-based
End Property

Private Sub AssignVariable(variable As Variant, value As Variant)
   If IsObject(value) Then
      Set variable = value
   Else
      Let variable = value
   End If
End Sub

Public Sub DebugPrint()
   Dim lItem As Long, lIndex As Long, vItem As Variant, oKVP As KeyValuePair
   lItem = 0
   For Each oKVP In KeyValuePairs
      lItem = lItem + 1
      Debug.Print lItem; oKVP.Key; " "; TypeName(oKVP.value);
      If InStr(1, TypeName(oKVP.value), "()") > 0 Then
         vItem = oKVP.value
         Debug.Print "("; CStr(LBound(vItem)); " to "; CStr(UBound(vItem)); ")";
         For lIndex = LBound(vItem) To UBound(vItem)
            Debug.Print " (" & CStr(lIndex) & ")"; TypeName(vItem(lIndex)); "="; vItem(lIndex);
         Next
         Debug.Print
      Else
         Debug.Print "="; oKVP.value
      End If
   Next
End Sub

'NB VBA Collection object index is 1-based, scripting.dictionary items array is 0-based
'cf Scripting.Dictionary Methods s.Add(Key, Item), s.CompareMode, s.Count, s.Exists(Key); _
   s.Item(Key) - updateable, s.Items, s.Key(Key), s.Keys, s.Remove(Key), s.RemoveAll
'Scripting.Dictionary has no index number; you can index the 0-based variant array of Items returned
'  unlike Collections which can be indexed starting at 1
'Efficient iteration is For Each varPair in thisdic.KeyValuePairs
'Another difference I introduce is that in a scripting.dictionary, the doc says
'  If key is not found when changing an item, a new key is created with the specified newitem.
'  If key is not found when attempting to return an existing item, a new key is created and its corresponding item is left empty.
'but I want to raise an error when addressing a key that does not exist
'similarly, the scripting.dictionary will create separate integer and string keys for eg 2
KeyValuePair.cls

Kode

Option Explicit
'Unrestricted class just to hold pairs of values together and permit Dictionary object updating
Public Key As String
Public value As Variant
Sist endret av NAPse; 29. mars 2017 kl. 14:51. Grunn: Automatisk sammenslåing med etterfølgende innlegg.
jamen yolo da.
Viva la Opium's Avatar
Trådstarter
Herlighet! Da jeg først åpnet den nedlastede filen fikk jeg fortsatt ikke opp verdiene. Da en av nabofirmaets folk sjekket på sin Mac funket den fint. Han hadde en litt eldre versjon av Excel, og bare for å teste oppdaterte han, hvorpå den ikke funket for ham heller.

Han er en utvikler og ble selvsagt besatt av å måtte finne en løsning, etter å forsøkt litt forskjellig som ikke funket helt, fant han til slutt ut hvorfor det ikke funket for våre Excel-er i stedet: Feilen og løsningen han kom fram til står beskrevet her:

«This turns out to be a line-ending issue. It appears Excel Mac requires Windows line-endings (CRLF) when importing modules and classes and saving Raw content from GitHub uses just a LF, causing this issue.

Solution: Download the full source code zip, https://github.com/VBA-tools/VBA-Dictionary/releases. I've set up the repo to always include CRLF for files, so cloning the repo or downloading the full source avoids these issues.»


Rekker ikke å teste full scale ennå, men det ser meget lovende ut.

Masse takk for hjelpen!