AW: 1. freie Zelle unabhängig von Anzahl Spalten
29.08.2012 07:09:31
Anzahl
Hallo Franz,
ich hab doch nochmal ein kleines Problem mit dem Code.
Hintergrund ist, dass der Bereich mit den Sprachen ein Bereich aus einer Tabelle ist, die mehrere Spalten hat. Dadurch funktioniert das mit dem Offset nicht so recht.
Falls die 1. Spalte in der Zeile über dem nächsten leeren Eintrag ausgefüllt ist, hat dein Code gut funktioniert, falls ich auch in der Spalte Sprachenkürzel (3 Spalten weiter rechts) einen Eintrag hatte, musste ich das Offset etwas anpassen.
Er berücksichtigt bei der Aktion Find also auch immer die umliegenden Spalten des angegebenen Bereichs.
Kann man das auch irgendwie aushebeln, sodass er sich wirklich nur auf die Spalte mit den Sprachen bezieht, selbst wenn der zu durchsuchende Bereich mehrere Spalten hat?
Vielen Dank dir für deine Mühe!
Sub Neue_Sprache_anlegen()
'Öffnet eine Input-Box, in welcher der User die neu anzulegende Sprache eingeben kann
'und fügt diese dann der Dropdownliste hinzu. Anschließend erfolgt noch eine alphabetische
'Sortierung der Sprachen.
'Deklaration der Variablen
Dim Sprache As Variant
Dim Zelle_für_Sprache As Range
Dim DD_Sprache_max As Range
Set DD_Sprache_max = Worksheets("Dropdownmenüs").Range("$F$648:$F$1147")
Dim Sprachenkürzel As Variant
'Merken des aktiven Arbeitsblatts
Aktives_Blatt = ActiveSheet.Name
'Abfrage der Daten durch Input-Boxen
Sprache = InputBox("Bitte trage die neu anzulegende Sprache ein, wie sie von der " & _
"Gesellschaft bezeichnet wird:", "Sprache angeben")
If Sprache = "" Then Exit Sub
Sprachenkürzel = InputBox("Bitte trage das Kürzel der anzulegenden Sprache ein, wie sie " & _
"von der Gesellschaft bezeichnet wird:", "Sprachenkürzel angeben")
'Abgleich der eingegebenen Sprache mit den bereits vorhandenen Sprachen
Set Zelle_für_Sprache = DD_Sprache_max.Find(What:=Sprache, LookIn:=xlValues, _
lookat:=xlWhole)
If Zelle_für_Sprache Is Nothing Then
'Falls Sprache noch nicht hinterlegt ist
'Letzte belegte Zelle suchen
With DD_Sprache_max
Set Zelle_für_Sprache = DD_Sprache_max.Find(What:="*", After:=.Range("A1"), _
LookIn:=xlFormulas, lookat:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlPrevious)
End With
'Falls noch keine Sprachen angelegt sind wird die Sprache in die erste Zeile eingetragen
If Zelle_für_Sprache Is Nothing Then
DD_Sprache_max.Range("A1").Value = Sprache
DD_Sprache_max.Range("D1").Value = Sprachenkürzel
'Falls schon Sprachen hinterlegt sind
Else
'Falls schon die maximale Anzahl an hinterlegbaren Sprachen hinterlegt ist
If DD_Sprache_max.Rows.Count = Application.WorksheetFunction.CountA(DD_Sprache_max) _
Then
MsgBox "Die maximale Anzahl an hinterlegbaren Sprachen ist erreicht. " & _
"Leider sind keine weiteren Einträge möglich", vbInformation + vbOKOnly, _
"Fehler beim Anlegen der neuen Sprache"
Exit Sub
Else
'Falls neue Sprache aufgenommen werden kann
Zelle_für_Sprache.Offset(0, -1).Value = Sprache
Zelle_für_Sprache.Offset(0, 2).Value = Sprachenkürzel
'Sortieren der Sprachen
With DD_Sprache_max
.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlNo
End With
End If
End If
Else
'Falls Sprache schon hinterlegt ist
MsgBox "Die Sprache """ & Sprache & """ ist schon vorhanden!", vbInformation + vbOKOnly, _
"Sprache schon vorhanden"
Exit Sub
End If
'Bestätigung der Anlage der Sprache
Sheets(Aktives_Blatt).Select
MsgBox "Die Sprache """ & Sprache & """ wurde angelegt.", vbOKOnly, "Sprache wurde angelegt"
End Sub