Sub einornden()
Dim lngCol As Long, lngRow As Long
Dim strInput As String
With Sheets("Tabelle1") 'Tabellenname anpassen!
strInput = Application.Proper(Trim(.Range("B4")))
If strInput <> "" Then
lngCol = Asc(strInput) - 64
If lngCol < 1 Or lngCol > 26 Then lngCol = 27
lngRow = Application.Max(9, .Cells(.Rows.Count, lngCol).End(xlUp).Row + 1)
If IsError(Application.Match(strInput, .Range(.Cells(8, lngCol), .Cells(lngRow, lngCol)), 0)) Then
.Cells(lngRow, lngCol) = strInput
.Range(.Cells(8, lngCol), .Cells(lngRow, lngCol)).Sort _
Key1:=.Cells(8, lngCol), Order1:=xlAscending, Header:=xlYes
.Range("B4") = ""
End If
End If
End With
End Sub
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngCol As Long, lngRow As Long
Dim strInput As String
On Error GoTo ErrorHandler
Application.EnableEvents = False
If Target.Address(0, 0) = "B4" Then
strInput = Application.Proper(Trim(Target))
Target = "": Target.Select
If strInput <> "" Then
lngCol = Asc(strInput) - 64
If lngCol < 1 Or lngCol > 26 Then lngCol = 27
lngRow = Application.Max(9, Cells(Rows.Count, lngCol).End(xlUp).Row + 1)
If IsError(Application.Match(strInput, Range(Cells(8, lngCol), Cells(lngRow, lngCol)), 0)) Then
Cells(lngRow, lngCol) = strInput
Range(Cells(8, lngCol), Cells(lngRow, lngCol)).Sort _
Key1:=Cells(8, lngCol), Order1:=xlAscending, Header:=xlYes
End If
End If
End If
ErrorHandler:
Application.EnableEvents = True
End Sub
A | B | C | D | E | F | G | H | AA | |
8 | A | B | C | D | E | F | G | H | Andere |
9 | Anna | Bandi | Claus | Esel | Gerd | Harald | Çaliskan | ||
10 | Anne | Berd | Elfriede | Guido | Heide | ||||
11 | Annette | Bert | Gisela | Heinz | |||||
12 | Brudi |