Miten saisi solualueeseen rajoituksen, että sama numero ei voi esiintyä kuin kerran (priorisointi)

Helpoin tapa taitaa olla "Ehdollinen muotoilu". Valitse solualue johon ehdot tulevat.
Aloitus-välilehdellä on "Ehdollinen muotoilu". Valitse siitä "Solujen korostussäännöt" ja sieltä "Arvojen kaksoiskappaleet". Avautuvassa ikkunassa valitse "Monista" (on oletuksena) ja anna sitten muotoilu. Oletuksena on hyvä "vaalean punainen täyttö ja tummanpunainen teksti. Nyt jos käyttäjä antaa jo olemassaolevan numeron, ehto täyttyy ja muotoilu tulee voimaan. Kun vaihtaa tilalle uuden, käyttämättömän numeron, poistuu muotoilu.

Lets leikitään asiaa valaisevalla esimerkillä. Tee perässä ja ymmärrät idean jota voit soveltaa omaan taulukkoosi.

Vallataan tässä leikissä vaikkapa kymmenen solun kokoinen alue D2:D11.
Tarve on yksinkertainen: alueen soluihin voi syöttää vain numeroita ja kutakin numeroa vain yhden kerran.

* maalaa alue D2:D11
* komenna Tiedot/Tietojen kelpoisuuden tarkistaminen
* Asetukset -välilehdelle määritetään seuraavaa:
-> Hyväksy: Oma ehto
-> Ruksi kohtaan Ohita tyhjät
-> Tiedot: on välillä
-> Kaava: =JA(ONLUKU(D2);LASKE.JOS(D$2:D11;D2)=1)
* Virhesanoma -välilehdelle määritetään seuraavaa:
-> Ruksi kohtaan Näytä virhesanoma, jos kirjoitetut tiedot eivät täytä ehtoja
-> Tyyli: Lopetus
-> Otsikko: VIRHE: tupla-arvo tai ei numero
-> Virhesanoma: Et voi syöttää kahta kertaa samaa arvoa. Vain numerot on sallittuja.

Testaa! Huomaat ettei numeroista poikkeavaa syöttöä hyväksytä eikä samaa numeroakaan toistamiseen.

edelliset postaukset eivät huomioi sitä , että jos esim. ne 100 lukua , niin hankalaa muistaa mitä lukuja on jo käyttänyt , koska luvut eivät poistu luettelosta.
Lisähaasteena tossa vielä sekin, että jos haluaa muuttaa jo solussa olevaa lukua vanha luku pitää palauttaa ja poistaa uusi luku listasta...
no tossa koodi...
nyt kelpoisuusehto H1:H100 ja luvut Ki:K100 , muuta sopivaksi

ko taulukon moduuliin...

Dim Vanhasolu As Variant
Dim Uusisolu As Variant
Public TyhjäSolu As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("H1:H10"), Target) Is Nothing Then
If Target.Count = 1 Then
If Target = "" Then
TyhjäSolu = True
Else
TyhjäSolu = False
End If
End If
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
Application.EnableEvents = False
Application.ScreenUpdating = False
If Not Intersect(Range("H1:H10"), Target) Is Nothing And TyhjäSolu Then
PoistaLuettelosta Target
ActiveWorkbook.Names("Lista").Delete
vika = Range("K1").End(xlDown).Row
If Not Range("K1") = "" Then
ActiveWorkbook.Names.Add Name:="Lista", RefersTo:=Range("K1:K" & vika)
Else
Range("H1:H100").Validation.Delete
End If
Else
If Not Intersect(Range("H1:H10"), Target) Is Nothing And Not TyhjäSolu Then
Uusisolu = Target.Value
Application.Undo
Vanhasolu = Target.Value

ActiveWorkbook.Names("Lista").Delete
vika = Range("K1").End(xlDown).Row
Range("K" & vika 1) = Vanhasolu
ActiveWorkbook.Names.Add Name:="Lista", RefersTo:=Range("K1:K" & vika 1)
Worksheets("Sheet1").Sort.SortFields.Clear
Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("K1:K" & vika 1), Order:=xlAscending
With Worksheets("Sheet1").Sort
.SetRange Range("K1:K" & vika 1)
.Apply
End With
Target = Uusisolu
Vanhasolu = Uusisolu
PoistaLuettelosta Uusisolu
End If
End If
TyhjäSolu = False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
tavalliseen moduuliin...

Sub resetoi()
Application.EnableEvents = True
Application.ScreenUpdating = True
TyhjäSolu = False
ActiveWorkbook.Names.Add Name:="Lista", RefersTo:=Range("K1:K100")
Range("K1") = 1
Range("K2") = 2
Range("K1:K2").AutoFill Destination:=Range("K1:K100"), Type:=xlFillDefault
Range("H1:H100") = ""
With Range("H1:H100").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$K$1:$K$100"
End With
End Sub
Sub PoistaLuettelosta(Hakuehto As Variant)
Worksheets("Sheet1").Activate
Dim solu As Range
With Range("K1:K10")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
solu.Delete shift:=xlUp
End If
End With
Worksheets("Sheet1").Sort.SortFields.Clear
Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("K1:K10"), Order:=xlAscending
With Worksheets("Sheet1").Sort
.SetRange Range("K1:K10")
.Apply
End With
End Sub

Keep EXCELing
@Kunde

lipsahti ekaksi fiksaamaton koodi tässä oikea...
edelliset postaukset eivät huomioi sitä , että jos esim. ne 100 lukua , niin hankalaa muistaa mitä lukuja on jo käyttänyt , koska luvut eivät poistu luettelosta.
Lisähaasteena tossa vielä sekin, että jos haluaa muuttaa jo solussa olevaa lukua vanha luku pitää palauttaa ja poistaa uusi luku listasta...
no tossa koodi...
nyt kelpoisuusehto H1:H100 ja luvut Ki:K100 , muuta sopivaksi

ko taulukon moduuliin...

Dim Vanhasolu As Variant
Dim Uusisolu As Variant
Public TyhjäSolu As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("H1:H100"), Target) Is Nothing Then
If Target.Count = 1 Then
If Target = "" Then
TyhjäSolu = True
Else
TyhjäSolu = False
End If
End If
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
Application.EnableEvents = False
Application.ScreenUpdating = False
If Not Intersect(Range("H1:H100"), Target) Is Nothing And TyhjäSolu Then
PoistaLuettelosta Target
ActiveWorkbook.Names("Lista").Delete
vika = Range("K1").End(xlDown).Row
If Not Range("K1") = "" Then
ActiveWorkbook.Names.Add Name:="Lista", RefersTo:=Range("K1:K" & vika)
Else
Range("H1:H100").Validation.Delete
End If
Else
If Not Intersect(Range("H1:H100"), Target) Is Nothing And Not TyhjäSolu Then
Uusisolu = Target.Value
Application.Undo
Vanhasolu = Target.Value

ActiveWorkbook.Names("Lista").Delete
vika = Range("K1").End(xlDown).Row
Range("K" & vika 1) = Vanhasolu
ActiveWorkbook.Names.Add Name:="Lista", RefersTo:=Range("K1:K" & vika 1)
Worksheets("Sheet1").Sort.SortFields.Clear
Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("K1:K" & vika 1), Order:=xlAscending
With Worksheets("Sheet1").Sort
.SetRange Range("K1:K" & vika 1)
.Apply
End With
Target = Uusisolu
Vanhasolu = Uusisolu
PoistaLuettelosta Uusisolu
End If
End If
TyhjäSolu = False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
tavalliseen moduuliin...

Sub resetoi()
Application.EnableEvents = True
Application.ScreenUpdating = True
TyhjäSolu = False
ActiveWorkbook.Names.Add Name:="Lista", RefersTo:=Range("K1:K100")
Range("K1") = 1
Range("K2") = 2
Range("K1:K2").AutoFill Destination:=Range("K1:K100"), Type:=xlFillDefault
Range("H1:H100") = ""
With Range("H1:H100").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$K$1:$K$100"
End With
End Sub
Sub PoistaLuettelosta(Hakuehto As Variant)
Worksheets("Sheet1").Activate
Dim solu As Range
With Range("K1:K100")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
solu.Delete shift:=xlUp
End If
End With
Worksheets("Sheet1").Sort.SortFields.Clear
Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("K1:K100"), Order:=xlAscending
With Worksheets("Sheet1").Sort
.SetRange Range("K1:K100")
.Apply
End With
End Sub

Keep EXCELing
@Kunde

Missä työssä joutuu priorisoimaan 100 tehtävää?

" Siinä voi helposti tulla tilanteita missä tämän päivän ranking poikkeaisi aika paljonkin huomenna saman ihmisen tekemästä rankingista."
Siksipä mä tommosen koodin rustasin, että voi tehdä muutoksia ja lista elää tilanteen mukaan... ;-)