Combobox-Inhalt mit Zellbereich vergleichen
04.04.2018 14:52:00
Andreas
ich steh mal wieder vor einem Problem welches ich nicht lösen kann.
Ich habe ein UserForm mit verschiedenen Boxen.
Mit der "ComboBoxParzZuf" wähle ich ein Blatt aus und aktiviere es. "ComboBox_ParzNeu" wird mit Werten gefüllt, es können aber auch eigene Werte eingetragen werden.
Mein Problem ist jetzt, das bei "CommandButtonParzZuf" noch abgefragt werden muss, ob der Wert in der "ComboBox_ParzNeu" schon im Zellbereich A9:A60 des aktiven Blattes vorkommt. Wenn der Wert schon vorhanden ist, soll eine Msgbox erscheinen.
In der "ComboBox_ParzNeu" können Ziffern und auch Buchstaben stehen.
Leider verstehe ich nicht so viel von VBA. Kann mir bitte Jemand weiterhelfen.
Option Explicit
Private wks As Worksheet
Private bolAktion As Boolean 'Merker, dass eine Aktion bereits ausgeführt wird
Private Sub Userform_Initialize()
Dim ws As Worksheet
'Blatteintrag in Combobox
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "ParzellenÜbersicht*" Then
If CLng(Right(ws.Name, 4)) = Year(Date) _
Or CLng(Right(ws.Name, 4)) = Year(Date) - 1 Or CLng(Right(ws.Name, 4)) = Year(Date) + 1 _
Then
Me.ComboBoxParzZuf.AddItem ws.Name
End If
End If
Next ws
With Me.ComboBox_ParzNeu
.RowSource = "ParzelleNeu"
.ListIndex = -1
End With
With Me.ComboBoxAnl
.RowSource = "Anlage"
.ListIndex = -1
ComboBoxAnl.ColumnWidths = "0 Pt;30 Pt"
End With
With Me.ComboBoxStrom
.List = ThisWorkbook.Sheets("Userform").Range("A3:B4").Value
.ListIndex = -1
ComboBoxStrom.ColumnWidths = "10 Pt;0 Pt"
End With
With Me.ComboBoxWass
.List = ThisWorkbook.Sheets("Userform").Range("A3:B4").Value
.ListIndex = -1
ComboBoxWass.ColumnWidths = "10 Pt;0 Pt"
End With
End Sub
Private Sub TextBox01_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57
Case Else
KeyAscii = 0
MsgBox "Es sind nur Ziffern zulässig!", vbInformation, "Hinweis"
End Select
End Sub
Private Sub CommandButtonParzZuf_Click()
Dim lngzeile As Long
lngzeile = Cells(9, 1).End(xlDown).Row + 1 ' erste leere Zeile suchen
Dim iAntwort As Integer
' Abfrage ob Pflichtfelder gefüllt sind
If ComboBoxParzZuf.ListIndex = -1 Or ComboBox_ParzNeu.ListIndex = "" Or ComboBoxAnl. _
ListIndex = -1 Or ComboBoxStrom.ListIndex = -1 Or ComboBoxWass.ListIndex = -1 Or TextBox01.Value = "" Then
MsgBox "Bitte alle Pflichtfelder * füllen!", vbInformation, "Achtung"
TextBoxleer.SetFocus
Else
'Abfrage ob Größe eingetragen
If TextBox01.Value 0 Then
iAntwort = MsgBox("Soll zugefügt werden?", vbYesNo)
If iAntwort = vbNo Then
TextBoxleer.SetFocus
End If
If iAntwort = vbYes Then
TrageWerteEin lngzeile
End If
Else
TrageWerteEin lngzeile
End If
End If
End If
Call ZeilenAusblenden
'ActiveSheet.Visible = False
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
'Unload ParzZufuegen
End Sub
Function TrageWerteEin(ByVal lngzeile As Long)
Cells(lngzeile, 1).Value = ComboBox_ParzNeu.Value
Cells(lngzeile, 2).Value = TextBox01.Value
Cells(lngzeile, 3).Value = ComboBoxAnl.Value
Cells(lngzeile, 4).Value = ComboBoxStrom.Value
Cells(lngzeile, 5).Value = ComboBoxWass.Value
Cells(lngzeile, 6).Value = TextBox02.Value
Cells(lngzeile, 10).Value = TextBox02.Value
Cells(lngzeile, 14).Value = TextBox04.Value
End Function 'Blatt aktivieren
Private Sub ComboBoxParzZuf_Change()
Dim wks As Worksheet
If ComboBoxParzZuf.ListIndex = -1 Then Exit Sub
If bolAktion = True Then Exit Sub
bolAktion = True
Set wks = Sheets(Format(ComboBoxParzZuf.Value, ("dd.mm.yy")))
ComboBoxParzZuf.Value = Format(ComboBoxParzZuf.Value, ("dd.mm.yy"))
'Application.ScreenUpdating = False
wks.Activate
bolAktion = False
Call ZeilenEinblenden
End Sub
mfg, Andreas