AW: Zahlenreihe bei Änderung anpassen
03.02.2017 16:44:40
ChrisL
Hi Peter
Hier noch eine Variante mit Userform.
https://www.herber.de/bbs/user/111158.xlsm
Bedingt, dass die Prioritäten ab 1 ohne Unterbruch durchnummeriert sind. Mehrere Projekte mit gleicher Priorität darf es nicht geben (ansonsten wäre die Ausgangslage falsch d.h. es könnte nur noch manuell bestimmt werden, ob eine Umpriorisierung eine neue Nummerierung erfordert).
Übrigens eine ganz einfach Lösung wäre, nach Prio zu sortieren und die Prio mit =ZEILE() anzugeben. Bei einer Umpriorisierung verschiebst du einfach die Zeile.
cu
Chris
Private Sub CommandButton1_Click()
Dim lAnzahl As Long, lPos As Long, i As Long
With Worksheets("Tabelle1")
lAnzahl = .Cells(Rows.Count, 1).End(xlUp).Row - 1
lPos = ListBox1.ListIndex + 1
ReDim ar1(1 To lAnzahl)
ReDim ar2(1 To lAnzahl)
ar1 = Application.Transpose(.Range("A2:A" & lAnzahl + 1))
For i = 1 To lAnzahl
If ar1(i) = lPos - 1 Then
ar2(i) = ar1(i) + 1
ElseIf ar1(i) = lPos Then
ar2(i) = ar1(i) - 1
Else
ar2(i) = ar1(i)
End If
Next i
.Range("A2:A" & lAnzahl + 1) = Application.Transpose(ar2)
End With
Call UserForm_Initialize
ListBox1.ListIndex = lPos - 2
End Sub
Private Sub CommandButton2_Click()
Dim lAnzahl As Long, lPos As Long, i As Long
With Worksheets("Tabelle1")
lAnzahl = .Cells(Rows.Count, 1).End(xlUp).Row - 1
lPos = ListBox1.ListIndex + 1
ReDim ar1(1 To lAnzahl)
ReDim ar2(1 To lAnzahl)
ar1 = Application.Transpose(.Range("A2:A" & lAnzahl + 1))
For i = 1 To lAnzahl
If ar1(i) = lPos + 1 Then
ar2(i) = ar1(i) - 1
ElseIf ar1(i) = lPos Then
ar2(i) = ar1(i) + 1
Else
ar2(i) = ar1(i)
End If
Next i
.Range("A2:A" & lAnzahl + 1) = Application.Transpose(ar2)
End With
Call UserForm_Initialize
ListBox1.ListIndex = lPos
End Sub
Private Sub CommandButton3_Click()
Unload UserForm1
End Sub
Private Sub ListBox1_Click()
If ListBox1.ListIndex = 0 Then
CommandButton1.Enabled = False
CommandButton2.Enabled = True
ElseIf ListBox1.ListIndex = ListBox1.ListCount - 1 Then
CommandButton1.Enabled = True
CommandButton2.Enabled = False
Else
CommandButton1.Enabled = True
CommandButton2.Enabled = True
End If
End Sub
Private Sub UserForm_Initialize()
Dim lAnzahl As Long, i As Long
ListBox1.Clear
With Worksheets("Tabelle1")
lAnzahl = .Cells(Rows.Count, 1).End(xlUp).Row - 2
ReDim ar(lAnzahl)
For i = 0 To lAnzahl
ar(i) = .Cells(Application.Match(i + 1, .Columns(1), 0), 2)
Next i
End With
ListBox1.List = ar
End Sub