Erstellung Dropdown-Menü für eingelesene Daten

[JonasRe]

Hallo zusammen,
in meiner Arbeitsmappe lese ich zu Beginn meine Daten vüber einen Button aus zwei verschiedenen Excel-Dateien ein. Dabei möchte ich, dass der Benutzer danach in zwei Bereichen nur Daten durch ein Drop-Down Menü auswählen kann.
Der relevante Teil meiner Arbeitsmappe habe ich dem Anhang beigefügt.

Dabei geht es zum einen um die Spalte P (ERA EG), welche nur Zahlen im Bereich von 1-17 annehmen soll und um den Bereich der Spalten T bis Y, welche mit A bis E bewertete werden können.

Meine Einlesemakro sieht so aus:

Code:

Sub DatenEinlesenColorado()

On Error Resume Next
Application.EnableEvents = False

'Einlesen der Daten für die Spalten A bis M, sowie die Spalte AG

Call DropDown

Call Readpersnr
Call Nameconvert
Call ReadEintritt
Call ReadDST
Call Readgeb
Call AlterEinlesen
Call DienstjahrFormelEinlesen

'Einlesen und gleichzeitiges kopieren der "Zukünftigen Daten" und der "Aktuellen Daten". Zudem werden Berechnungen angestoßen um Spaltenwerte zu ermitteln

Call ReadEG
Call ReadIRWAZSTD
Call Convertabcde
Call ReadLBUSZ
Call EGGehalt

Call platzhalter
Call LBProzentEinlesen
Call LBEinlesen
Call MEKhEinlesen
Call irwazEinlesen
Call JEK
Call DeltaMEK35berechnen
Call DeltaMEKIrwazberechnen
Call DeltaMEKProzent

         
Application.EnableEvents = True
On Error GoTo 0

'Einlesen der Daten aus der Vorjahrestabelle

Dim instring1 As String
Dim instring2 As String
Dim instring3 As String
Dim instring4 As String
Dim instring5 As String
Dim instring6 As String
Dim outstring() As String
Dim book, mybook As Workbook
Dim sourceline, destinationline As Integer
Dim Pfad As String
Dim location As String
Dim Identification As Long
Dim Help As Range


Set mybook = ActiveWorkbook
Pfad = (mybook.Worksheets("Parameter").Cells(2, 1))
Set book = Workbooks.Open(Filename:=Pfad, ReadOnly:=True)

sourceline = 3
destinationline = 3

Set Help = mybook.Worksheets("Gehaltsdaten").Range("A3:A3000")

On Error GoTo Fehler

While (destinationline < 1000)

'Nimmt die Personalnummer aus der Lasche "Mitarbeiterdaten" und ordnet die entsprechenden Daten anschliesen der richtigen Nummer in der Gehaltstabelle zu

With book.Worksheets("Gehaltsdaten")

Identification = .Cells(destinationline, 1)

   instring1 = .Cells(destinationline, 9)       'Spalte I
   instring2 = .Cells(destinationline, 10)      'Spalte J
   instring3 = .Cells(destinationline, 11)      'Spalte K
   instring4 = .Cells(destinationline, 12)      'Spalte L
   instring5 = .Cells(destinationline, 13)      'Spalte M
   instring6 = .Cells(destinationline, 33)      'Spalte AG

End With

location = WorksheetFunction.Match(Identification, Help, 0)

location = location + 2

With mybook.Worksheets("Gehaltsdaten")

   .Cells(location, 9) = instring1
   .Cells(location, 10) = instring2
   .Cells(location, 11) = instring3
   .Cells(location, 12) = instring4
   .Cells(location, 13) = instring5
   .Cells(location, 33) = instring6

End With

Sprung:

destinationline = destinationline + 1

sourceline = sourceline + 1


Wend

MsgBox "Die Daten wurden eingelesen!", vbInformation

book.Close savechanges:=False
Exit Sub

Fehler:
    Resume Sprung
End Sub

Ich habe bereits versucht mit dem Makrorekorder die Bereiche zu formatieren, jedoch erhalte ich einen Fehler (Fehler beim Kompilieren: Variable oder Prozedur anstelle eines Moduls erwartet) , wenn ich das Makro beim Einlesen aufrufe. Führe ich das Einlesen und das Makro für die DropDown-Liste seperat aus, funktioniert alles. Jedoch möchte ich es gerne in einem Schritt machen.

Code:

Sub DropDown()
   Range("P3:P1000").Select
   With Selection.Validation
       .Delete
       .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
       xlBetween, Formula1:="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17"
       .IgnoreBlank = True
       .InCellDropdown = True
       .InputTitle = ""
       .ErrorTitle = ""
       .InputMessage = ""
       .ErrorMessage = ""
       .ShowInput = True
       .ShowError = True
   End With
   ActiveWindow.ScrollColumn = 13
   ActiveWindow.ScrollColumn = 14
   ActiveWindow.ScrollColumn = 15
   ActiveWindow.ScrollColumn = 16
   ActiveWindow.ScrollColumn = 15
   Range("T3:Y1000").Select
   With Selection.Validation
       .Delete
       .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
       xlBetween, Formula1:="A,B,C,D,E"
       .IgnoreBlank = True
       .InCellDropdown = True
       .InputTitle = ""
       .ErrorTitle = ""
       .InputMessage = ""
       .ErrorMessage = ""
       .ShowInput = True
       .ShowError = True
   End With                     
End Sub

Bin über jegliche Hilfe dankbar :)

[Steffl]

Hallo Jonas,

hast Du das mit der Gültigkeitsliste mal ohne VBA gemacht? Deine Fehlerbehandlung im anderen Makro finde ich nicht optimal. Du springst da mitten in einer Schleife rein!

[JonasRe]

Hallo Steffl,

ich habe es jetzt auf eine andere Art gelöst und es funktioniert soweit.

Könntest du das mit der Fehlerbehandlung etwas genauer erläutern? Ich bin recht neu bei VBA und würde gerne deinen Vorschlag umsetzen.

Danke :)

Code:

Sub DatenEinlesenColorado()

On Error Resume Next
Application.EnableEvents = False

'Einlesen der Daten für die Spalten A bis M, sowie die Spalte AG

Call Readpersnr
Call Nameconvert
Call ReadEintritt
Call ReadDST
Call Readgeb
Call AlterEinlesen
Call DienstjahrFormelEinlesen

'Einlesen und gleichzeitiges kopieren der "Zukünftigen Daten" und der "Aktuellen Daten". Zudem werden Berechnungen angestoßen um Spaltenwerte zu ermitteln

Call ReadEG
Call ReadIRWAZSTD
Call Convertabcde
Call ReadLBUSZ
Call EGGehalt

Call platzhalter
Call LBProzentEinlesen
Call LBEinlesen
Call MEKhEinlesen
Call irwazEinlesen
Call JEK
Call DeltaMEK35berechnen
Call DeltaMEKIrwazberechnen
Call DeltaMEKProzent
       
Application.EnableEvents = True
On Error GoTo 0

'Erzeugung des DropDown-Menüs zur Datenvalidierung

Dim Zeile As Integer

Zeile = 3

Set book1 = ActiveWorkbook

While (book1.Worksheets("Gehaltsdaten").Cells(Zeile, 1) <> "")

With book1.Worksheets("Gehaltsdaten").Cells(Zeile, 16).Validation
   .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17"
   .ErrorMessage = "Geben Sie bitte eine Zahl zwischen 1 und 17 ein!"
End With

With book1.Worksheets("Gehaltsdaten").Cells(Zeile, 20).Validation
   .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="A,B,C,D,E"
   .ErrorMessage = "Geben Sie bitte eine Bewertung von A bis E ein!"
End With

With book1.Worksheets("Gehaltsdaten").Cells(Zeile, 21).Validation
   .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="A,B,C,D,E"
   .ErrorMessage = "Geben Sie bitte eine Bewertung von A bis E ein!"
End With

With book1.Worksheets("Gehaltsdaten").Cells(Zeile, 22).Validation
   .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="A,B,C,D,E"
   .ErrorMessage = "Geben Sie bitte eine Bewertung von A bis E ein!"
End With

With book1.Worksheets("Gehaltsdaten").Cells(Zeile, 23).Validation
   .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="A,B,C,D,E"
   .ErrorMessage = "Geben Sie bitte eine Bewertung von A bis E ein!"
End With

With book1.Worksheets("Gehaltsdaten").Cells(Zeile, 24).Validation
   .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="A,B,C,D,E"
   .ErrorMessage = "Geben Sie bitte eine Bewertung von A bis E ein!"
End With

With book1.Worksheets("Gehaltsdaten").Cells(Zeile, 25).Validation
   .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="A,B,C,D,E"
   .ErrorMessage = "Geben Sie bitte eine Bewertung von A bis E ein!"
End With

Zeile = Zeile + 1

Wend

'Einlesen der Daten aus der Vorjahrestabelle

Dim instring1 As String
Dim instring2 As String
Dim instring3 As String
Dim instring4 As String
Dim instring5 As String
Dim instring6 As String
Dim outstring() As String
Dim book, mybook As Workbook
Dim sourceline, destinationline As Integer
Dim Pfad As String
Dim location As String
Dim Identification As Long
Dim Help As Range


Set mybook = ActiveWorkbook
Pfad = (mybook.Worksheets("Parameter").Cells(2, 1))
Set book = Workbooks.Open(Filename:=Pfad, ReadOnly:=True)

sourceline = 3
destinationline = 3

Set Help = mybook.Worksheets("Gehaltsdaten").Range("A3:A3000")

On Error GoTo Fehler

While (destinationline < 1000)

'Nimmt die Personalnummer aus der Lasche "Mitarbeiterdaten" und ordnet die entsprechenden Daten anschliesen der richtigen Nummer in der Gehaltstabelle zu

With book.Worksheets("Gehaltsdaten")

Identification = .Cells(destinationline, 1)

   instring1 = .Cells(destinationline, 9)       'Spalte I
   instring2 = .Cells(destinationline, 10)      'Spalte J
   instring3 = .Cells(destinationline, 11)      'Spalte K
   instring4 = .Cells(destinationline, 12)      'Spalte L
   instring5 = .Cells(destinationline, 13)      'Spalte M
   instring6 = .Cells(destinationline, 33)      'Spalte AG

End With

location = WorksheetFunction.Match(Identification, Help, 0)

location = location + 2

With mybook.Worksheets("Gehaltsdaten")

   .Cells(location, 9) = instring1
   .Cells(location, 10) = instring2
   .Cells(location, 11) = instring3
   .Cells(location, 12) = instring4
   .Cells(location, 13) = instring5
   .Cells(location, 33) = instring6

End With

Sprung:

destinationline = destinationline + 1

sourceline = sourceline + 1


Wend

MsgBox "Die Daten wurden eingelesen!", vbInformation

book.Close savechanges:=False
Exit Sub

Fehler:
    Resume Sprung
                                           
End Sub

[Steffl]

Hallo Jonas,

bezüglich der Fehlerbehandlung kannst Du mal Fehlerbehandlung (0) - Einführung und folgende 6 Kapitel lesen.

Zu deinem Code

1. Es gibt eine nicht deklarierte Variable book1
2. Bei einer solchen

Code:

Dim book, mybook As Workbook

Variablendekleration ist nur die Variable mybook vom Typ Workbook, book hat den Typ Variant.
3. Excel hat auch in den älteren Versionen mehr als 32.767 Zeilen. Nimm anstelle von Integer den Typ Long.
4. Hier

Code:

Dim location As String

weist Du der Variable den Typ String zu und hier

Code:

location = WorksheetFunction.Match(Identification, Help, 0)

location = location + 2

befüllst Du die Variable mit einer Zahl und machst danach noch eine Addition. Da läufst Du in einen Fehler.
4. Du reagierst hier

Code:

Exit Sub

Fehler:
    Resume Sprung
                                           
End Sub

gar nicht richtig auf den fehler, sondern machst einfach weiter. Das solltest Du nicht tun, siehe obigen Link.