Fehler Datenüberprüfung
01.01.2023 17:55:07
ChrisDerAnfänger
Ich habe eine Datei mit mehreren Blättern, die aufeinander zugreifen und in denen u.a. Leistungsdaten von Mitarbeitern stehen. Ich habe eine Mitarbeiterliste mit zwei Teams. Manchmal brauche ich alle, manchmal nur ein Team, weswegen ich die Tabelle so ergänzt habe, dass in einer Spalte das Team angegeben ist. Über die Funktion "FILTER" werden die MA dann auf zwei weitere Tabellen aufgesplittet.
In einem Blatt, auf dem die MA-Daten von verschiedenen anderen Blättern zusammengetragen werden, gibt es eine Datenüberprüfung, in dem die MA aufgelistet sind. Über VBA kann dann entweder das komplette Projekt oder ein einzelnes Team ausgewählt werden.
Mittels Internetrecherche, Macrorecorder (z.B. für das Einfügen der Formeln in die Zellen...) und meinen äußerst bescheidenen VBA-Kenntnissen (die aber immerhin dafür gereicht haben, dass das Drehfeld mit Daten aus Zellen gefüttert wird...) habe ich dann folgenden Code zusammen gebastelt, der tatsächlich der zweite Versuch war:
Sub MAUbersicht_Projekt()
With ActiveSheet.Range("$L$8")
Dim Eintraege As String, Obj As Range
For Each Obj In Tabelle68.Range("B6:B66")
Eintraege = Eintraege & Obj.Value & ","
Next Obj
With .Validation
On Error Resume Next
.Delete
If Eintraege "" Then
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=Left$(Eintraege, Len(Eintraege) - 1)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = "MeineInfo"
.ErrorMessage = "Diese Eingabe ist falsch!"
.ShowInput = True
.ShowError = False
End If
End With
End With
ActiveSheet.Shapes.Range(Array("Spinner 27")).Select
With Selection
.Value = Range("Mitarbeiterliste!K6").Value
.Min = 1
.Max = Range("Mitarbeiterliste!K6").Value
.SmallChange = 1
.LinkedCell = "Mitarbeiterliste!$H$6"
.Display3DShading = True
End With
Range("C8:G8").Select
ActiveCell.FormulaR1C1 = _
"=""::: ""&IF(RC[9]="""",XLOOKUP(Mitarbeiterliste!R[-2]C[5],Mitarbeiterliste!R[-2]C[4]:R[58]C[4],Mitarbeiterliste!R[-2]C[-1]:R[58]C[-1]),RC[9])&"" :::"""
Range("C7").Select
ActiveCell.Formula2R1C1 = _
"=""'""&IF(R[1]C[9]="""",XLOOKUP(Mitarbeiterliste!R[-1]C[5],Mitarbeiterliste!R[-1]C[4]:R[59]C[4],t_MA35[Kennung]),XLOOKUP(R[1]C[9],t_MA35[Mitarbeiter],t_MA35[Kennung]))&""'"""
Sheets("Mitarbeiterliste").Select
Range("K6").Select
Selection.Copy
Range("H6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("MA_Übersicht_AHT").Select
ActiveSheet.Shapes.Range(Array("Button 36")).Select
Selection.Characters.Text = "Projekt"
With Selection.Characters(Start:=1, Length:=7).Font
.Name = "Calibri"
.FontStyle = "Fett"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
ActiveSheet.Shapes.Range(Array("Button 37")).Select
Selection.Characters.Text = "Team 1"
With Selection.Characters(Start:=1, Length:=9).Font
.Name = "Calibri"
.FontStyle = "Standard"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
ActiveSheet.Shapes.Range(Array("Button 38")).Select
Selection.Characters.Text = "Team 2"
With Selection.Characters(Start:=1, Length:=7).Font
.Name = "Calibri"
.FontStyle = "Standard"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("A1").Select
End Sub
Die Subs sind dann entsprechenden Schaltflächen zugewiesen.
Erstaunlicherweise funktioniert das so auch und das wie erwähnt beim zweiten Versuch...
Mein Problem: Bei jedem Start der Datei zeigt Excel folgendes an:
"Wir haben ein Problem bei einigen Inhalten in "..." erkannt. Sollen wir so viel wie möglich wiederherstellen? Wenn Sie der Quelle dieser Arbeitsmappe vertrauen, klicken Sie bitte auf "Ja"."
Wenn man auf "Ja" klickt kommt dann irgendwann:
"Entferntes Feature: Datenüberprüfung von /xl/worksheets/sheet6.xml-Part"
Die Datenüberprüfung ist dann weg. Klickt man eine der Schaltflächen wieder an, ist die Datenüberprüfung aber wieder da und funktioniert tadellos.
Ich hoffe jemand kann mir so helfen - leider ist die Datei praktisch fertig und mit vielen Daten gefüllt, sodass ich nicht so einfach das ganze hochladen kann.
Vielen Dank schon mal. ;-)
Anzeige