Makro: Datenüberprüfung-Eingabemeldung
26.09.2020 18:36:44
NicSteel
ich habe mal wieder ein Problem - es wäre nett, wenn ihr mir bei der Lösung helfen würdet ...
Hintergrund: Mein Datensatz besteht aus 1.000 Zeilen mit 60 Spalten. Die Zellfarbe einiger Zellen markiere ich mittels Makro (spielt jetzt keine Rolle). Dann verkleinere ich die Ansicht auf 10%, um anhand der Zellfarben irgendwelche Trends zu erkennen. Ich möchte dann mitten in den Datensatz klicken - und Information über genau diese Zelle erhalten. Diese Informationen befinden sich:
Im Forum habe ich gesucht und bin auf einen Hinweis von Hajo_Zi gestoßen. Der war sehr hilfreich: nämlich einfach die "Datenüberprüfung mit Eingabemeldung" in einem Makro verwenden. Das habe ich dann mit einer for-Schleife getan und war auch erfolgreich (mit 10 Zeilen und 15 Spalten): Beim Klicken in eine Zelle werden alle Information richtig angezeigt. Beim Start des Makros mit 60.000 Zellen hängt sich Excel aber auf!
Meine nächste Idee war: nicht alle 60.000 Zellen von vornherein mit dem Makro zu bearbeiten, sondern wirklich nur die gerade ausgewählte Zelle. Das mache ich mit dem "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" - Ereignis im Worksheet-Modul. Aber das funktioniert nicht !
Die Datei habe ich hochgeladen: https:// _
www.herber.de/bbs/user/140458.xlsm
Und hier der Code, vielen Dank schonmal:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim t As Long
Dim j As Long
Dim s As Long
Dim ersteZeit As Long
Dim letzteZeit As Long
Dim erstePlatte As Long
Dim letztePlatte As Long
ersteZeit = 7
letzteZeit = 20
erstePlatte = 1
letztePlatte = 4
'ausgeschlossener Bereich
If Target.Rows letzteZeit Then
If Target.Column (5 * letztePlatte + 3) Then
Exit Sub
End If
End If
'aktiver Bereich
For t = ersteZeit To letzteZeit
For s = erstePlatte To letztePlatte
For j = (5 * s - 1) To (5 * s + 3)
If Target.Rows = t Then
If Target.Column = j Then
With Cells(t, j).Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop,_
Operator:= xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = "Information zur Zelle"
.ErrorTitle = ""
.InputMessage = vbCrLf & "Zeit: " & CDate(Cells(t, 3).Value) &_
vbCrLf & "Shelf: " & s & vbCrLf & "Position: " & Cells(5, j) &_
vbCrLf & "Thermoelement: " & Cells(6, j)
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End If
Next j
Next s
Next t
End Sub
Anzeige