Problemer med identisk productID

altså nummeret bliver lagt til, så de productID som er ens, derefter er forskellige.

Det vil sige, at i din bestående liste af rækker med productID i kolonne 2 - ønsker du at tilføje et "løbenr", når et produktID findes i forvejen.

- Skal dette løbenr begynde med 1 når produktID skifter?
- Hvad mener du med følgende:"men system kan ikke indlæse produkter som har det samme ID"

Det vil sige, at i din bestående liste af rækker med productID i kolonne 2 - ønsker du at tilføje et "løbenr", når et produktID findes i forvejen. -- JA præcis

- Skal dette løbenr begynde med 1 når produktID skifter?-- JA

- Hvad mener du med følgende:"men system kan ikke indlæse produkter som har det samme ID" -- Det er bare at vores produkt system kan ikke håndtere at der findes flere varer med samme ID. Vi sælger dele til biler, og derfor kan en vare som passer til en vw godt passe til en audi også. derfor opstår problemet, da de skal tilføjes under begge mærker.

Et eksempel:

Numre der skal ændres:
11110
11230
11110
11254
11230

ændres fx til:
11110
11230
11110-1
11254
11230-1
11110-2

eller lignende.

OK - vender tilbage

Kan et separat ark i mappen anvendes til at holde styr på løbenr. hvis dette viser sig nødvendigt?

ja jeg kan ikke se hvorfor ark2 ikke skulle kunne bruge stil at holde styr på løbenumre, så kan vi vel også selv ændre i dem hvis det er?

Her er koden, der kan ændre de bestående nr. på arket - hvad med fremover???

Tag en kopi af filen/arket inden.

Hver opmærksom på, at datatypen ændres når et produktnr. får tilføjet et løbenr, fra tal til tekst.

Lægges ind på det pågældende ark i VBA (Alt+F11)
=====================================================

Dim antalRæk, idTabel()
Sub ProductID()
Dim idnr
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
    ReDim idTabel(antalRæk, 2)
    For ræk = 2 To antalRæk
        idnr = Cells(ræk, 2)
        løbenr = findesID(idnr)
        If løbenr > 0 Then
            Cells(ræk, 2) = CStr(Cells(ræk, 2)) + "-" + CStr(løbenr)
        End If
    Next ræk
End Sub
Private Function findesID(idnr)
Dim f
    For f = 0 To antalRæk - 1
        If idTabel(f, 0) = "" Then
            idTabel(f, 0) = idnr
            idTabel(f, 1) = 1
            findesID = 0
            Exit Function
        End If
       
        If idTabel(f, 0) = idnr Then
            findesID = idTabel(f, 1)
            idTabel(f, 1) = idTabel(f, 1) + 1
            Exit Function
        End If
    Next f
    Stop
End Function

Eller hvad med en formel. Indsættes i B1 f.eks. og kopieres ned

=HVIS(TÆL.HVIS(A$1:A1;A1)>1;A1&"-"&TÆL.HVIS(A$1:A1;A1)-1;A1)

Så lige det var kolonne 2.

=HVIS(TÆL.HVIS(B$1:B1;B1)>1;B1&"-"&TÆL.HVIS(B$1:B1;B1)-1;B1)

supertekst smid lige et svar, det virker... MRJH jeg har ikke lige prøvet dit. men tak for hjælpen alligevel

Det gør jeg. Har en version 2, der kan anvendes når version 1 er udført - d.v.s. ved efterfølgende oprettelse af nye productId. Den kan du også få, hvis du er interesseret.

Den må du da meget gerne sende mig den version 2 altså...

Rem Version 2
Rem =========
Dim antalRæk, idTabel()
Sub ProductID()
Dim idnr
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
    ReDim idTabel(antalRæk, 2)

Rem opdatering af alle allerede udvidede productID
    For ræk = 2 To antalRæk
        idnr = Cells(ræk, 2)
       
        If InStr(idnr, "-") > 0 Then
            OpdaterTabel idnr
        End If
    Next ræk
   
Rem opdatering af nye productID uden løbenr
    For ræk = 2 To antalRæk
        idnr = Cells(ræk, 2)
       
        If InStr(idnr, "-") = 0 Then
            løbenr = findesID(CStr(idnr))
            If løbenr > 0 Then
                Cells(ræk, 2) = CStr(Cells(ræk, 2)) + "-" + CStr(løbenr)
            End If
        End If
    Next ræk
   
    MsgBox ("Opdatering af productID afsluttet")
End Sub
Private Function findesID(idnr)
Dim f
    For f = 0 To antalRæk - 1
        If idTabel(f, 0) = "" Then
            idTabel(f, 0) = idnr
            idTabel(f, 1) = 1
            findesID = 0
            Exit Function
        End If
       
        If idTabel(f, 0) = idnr Then
            findesID = idTabel(f, 1)
            idTabel(f, 1) = idTabel(f, 1) + 1
            Exit Function
        End If
    Next f
    Stop
End Function
Private Function OpdaterTabel(idnr)
Dim f, p, id, løbenr
    p = InStr(idnr, "-")
    id = Left(idnr, p - 1)
    løbenr = Mid(idnr, p + 1)
   
    For f = 0 To antalRæk - 1
        If idTabel(f, 0) = id Then
            idTabel(f, 0) = id
            idTabel(f, 1) = løbenr + 1
            Exit Function
        Else
            If idTabel(f, 0) = "" Then
                idTabel(f, 0) = id
                idTabel(f, 1) = løbenr + 1
                Exit Function
            End If
        End If
    Next f
End Function