Sök efter unika värden

[Monshi]

Som sagt, det är exakt det koden gör ju!

 

kanske att den behöver en sista "tweak" för att fungera precis som du vill, att värdena kopieras ut till lämplig kolumn.

 

Om vi tar del ett av koden

 On Error Resume Next
   	For Each myCell In Blad1.Range("C6").Resize(Blad1.Cells.SpecialCells(xlCellTypeLastCell).Row)

       	If myCell <> "" Then
           	myCell.Offset(0, 3) = Right(myCell, Len(myCell) - InStr(InStr(1, myCell, "-") + 1, myCell, "-"))
       	End If
   	Next myCell
On Error GoTo 0

kopierar den ut delen efter sista - till kolumnen tre steg till höger om cellen den kopierar från (från C6 till F6 för första cell)

fast C6? Borde inte startcellen vara A6? Samt då att det borde står Offset(0,5)?

 

Samt F-kolumnen borde rensas innan operation:

Blad1.Range("F:F").Clear

så att inte gamla värden ligger kvar och stör sorteringen.

 

Andra delen

With Blad1.Sort
   	.SortFields.Clear
   	.SortFields.Add Key:=Blad1.Range("A6"), _
           	SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   	.SortFields.Add Key:=Blad1.Range("A6"), _
   	SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   	.SetRange Blad1.Range("A5:E5").Resize(Blad1.Cells.SpecialCells(xlCellTypeLastCell).Row)

   	.Header = xlYes
   	.MatchCase = False
   	.Orientation = xlTopToBottom
   	.SortMethod = xlPinYin
   	.Apply
End With

Men primära nyckeln, ska inte det vara värdena i F? Dvs första referens ska vara till F6.

Samt området som sorteras måste inkludera värdena i F

.SetRange Blad1.Range("A5:[b]F[/b]5").Resize(Blad1.Cells.SpecialCells(xlCellTypeLastCell).Row)

 

Sådärdå

[Pellestek]

Jag får det inte att fungera.

Det ska vara som du säger, siffrorna efter bindestrecket, antingen det första - eller andra -, så ska det sorteras från minsta till största talet.

3-3000-1

3-3000-9

3-3000-50

3-3000-127

 

inte

 

3-3000-1

3-3000-127

3-3000-50

3-3000-9

 

Mvh Peter

3557.xls

[Monshi]

Nä, det är ju tre fel i koden

1: Du raderar ju det du ska sortera på innan du använder det!

2: Du anger inte att primära nyckeln finns i F

3: F-kolumnen finns inte med i området som ska sorteras.

 

Ja, lite sådana ändringar och du har exakt vad du behöver nedan.

Sub SorteraA()
'
' Kortkommando: Ctrl+f
'

Blad1.Range("F:F").Clear
On Error Resume Next
   	For Each myCell In Blad1.Range("A6").Resize(Blad1.Cells.SpecialCells(xlCellTypeLastCell).Row)

       	If myCell <> "" Then
           	myCell.Offset(0, 5) = Right(myCell, Len(myCell) - InStr(InStr(1, myCell, "-") + 1, myCell, "-"))
       	End If
   	Next myCell
On Error GoTo 0




With Blad1.Sort
   	.SortFields.Clear
   	.SortFields.Add Key:=Blad1.Range("f6"), _
           	SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   	.SortFields.Add Key:=Blad1.Range("A6"), _
   	SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   	.SetRange Blad1.Range("A6:f6").Resize(Blad1.Cells.SpecialCells(xlCellTypeLastCell).Row)
   	.Header = xlNo
   	.MatchCase = False
   	.Orientation = xlTopToBottom
   	.SortMethod = xlPinYin
   	.Apply
End With
Blad1.Range("F:F").Clear
End Sub

[Pellestek]

Japp, nu fungerar det som tänkt.

Tack för tålamodet

 

Mvh Peter

[Pellestek]

Jag har gjort ändringar i cellen där jag söker detta,

3-3000-1

3-3000-9

3-3000-50

3-3000-127

I cellen står det såhär nu,

3000-1

3000-9

3000-50

3000-127

Går det att söka efter detta istället?

Peter

 

 

 

Sub Main()
       Dim myRn As Range

       Set myRn = Blad1.Range("e6").Resize(Blad1.Cells.SpecialCells(xlCellTypeLastCell).Row - 1)

       Dim myCell As Range
       Dim i As Integer, j As Integer
       For Each myCell In myRn
       If myCell <> "" Then
               i = InStr(1, myCell, "-")
               If i <> 0 Then
               j = InStr(i + 1, myCell, "-")
               If j - i = 5 Then
                       myCell.Offset(0, -4) = myCell
                       myCell = ""
               End If
               End If
       End If

       Next myCell

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub

[Monshi]

Det borde du kunna klura ut själv

 

Tips: vad gör Instr måhända?

[Pellestek]

Tack för tipset, nu flyttar den

 

3000-1

3000-9

3000-50

3000-127

Sub Main()
       Dim myRn As Range

       Set myRn = Blad1.Range("e6").Resize(Blad1.Cells.SpecialCells(xlCellTypeLastCell).Row - 1)

       Dim myCell As Range
       Dim i As Integer, j As Integer
       For Each myCell In myRn
       If myCell <> "" Then

               j = InStr(i + 1, myCell, "-")
               If j - i = 5 Then
                       myCell.Offset(0, -4) = myCell
                       myCell = ""
               End If
               End If


       Next myCell

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub

 

 

 

 

 

Men nu när jag sorterar efteråt så måste jag ändra denna, men jag vet inte hur?

 

Sub SorteraA()
'
' Kortkommando: Ctrl+f
'

       Blad1.Range("F:F").Clear
       On Error Resume Next
       For Each myCell In Blad1.Range("A6").Resize(Blad1.Cells.SpecialCells(xlCellTypeLastCell).Row)

               If myCell <> "" Then
               myCell.Offset(0, 5) = Right(myCell, Len(myCell) - InStr(InStr(1, myCell, "-") + 1, myCell, "-"))
               End If
       Next myCell
       On Error GoTo 0




       With Blad1.Sort
       .SortFields.Clear
       .SortFields.Add Key:=Blad1.Range("f6"), _
               SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
       .SortFields.Add Key:=Blad1.Range("A6"), _
       SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
       .SetRange Blad1.Range("A6:f6").Resize(Blad1.Cells.SpecialCells(xlCellTypeLastCell).Row)
       .Header = xlNo
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
       End With
       Blad1.Range("F:F").Clear
End Sub

 

[Monshi]

Samma sak där, vad gör Instr i denna rad

myCell.Offset(0, 5) = Right(myCell, Len(myCell) - InStr(InStr(1, myCell, "-") + 1, myCell, "-"))

 

Men, en fråga på detta. Förekommer båda fallen eller har du helt övergått till artikelnummer med ett bindestreck?

 

Dvs ska vi hårdkoda för unika fallet eller anpassa koden så att den fungerar i båda?

[Pellestek]

Tack för hjälpen, jag testar detta.

Jag återkommer om jag behöver söka efter båda.

 

Mvh Peter

[Pellestek]

Det har uppkommit ett problem, vi är 2 st som använder samma template.

Jag har svensk Windows och och den andra har engelsk Windows, jag har problem med "Blad1" och "Sheet1".

Är det enklast att använda 2 templates?

 

Peter

[Monshi]

Adressera på annat vis då. Exempelvis via bladnamn eller index.

Worksheets("MittBlad")

eller

Worksheets(1)

eller kanske via namngiven cell på bladet

Range("MinCell").Parent

 

eller i nödfall ActiveSheet.

 

 

Intressant att det kan bli fel på det viset vid mallar, det ska jag medge att jag inte tänkte på. Det finns, som du ser ovan, ett antal vägar att gå runt i vilket fall som helst. ta det som passar dig bäst

[Pellestek]

Tack, Worksheets(1) verkar fungera bra.

[Pellestek]

Hur ska jag göra för att denna koden ska köras i en annan excelfil, sökvägen

C:\Dokument\fil.xls

 

 

 

Sub Main()
       Dim myRn As Range

       Set myRn = Worksheets(1).Range("e6").Resize(Worksheets(1).Cells.SpecialCells(xlCellTypeLastCell).Row - 1)

       Dim myCell As Range
       Dim i As Integer, j As Integer
       For Each myCell In myRn
       If myCell <> "" Then

               j = InStr(i + 1, myCell, "-")
               If j - i = 5 Then
                       myCell.Offset(0, -4) = myCell
                       myCell = ""
               End If
               End If


       Next myCell

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

 

 

[Monshi]

Du vill från din nuvarande bok köra koden i en annan bok, på ett blad där?

 

Då måste du skapa en referens till denna bok. Om redan öppen

Workbooks("fil.xls").Worksheets(1)....

Om du även ska öppna den

Dim wb As Workbook

Set wb = Workbooks.Open("C:\Dokument\fil.xls")
wb.Worksheets(1)....