IF Bedingung mit Dropdownabfrage in VBA
01.09.2014 11:04:55
Oli
ich habe folgende Herausforderung.
Unten stehendes Makro funktioniert soweit einwandfrei.
Aktuell wird aus Sheet 2 der Inhalt aus Zelle 37 ausgelesen und bei Übereinstimmung im Sheet 3 in einer Matrix ein Eintrag hinterlegt.
Mein Problem ist aktuell, dass ich in Sheet 3 noch ein Dropdownliste in den Cellen C19-C26 aufgenommen habe.
Das Marko sollte nun erweitert werden um die Funktion, dass nur wenn im Sheet2 in der jeweilgen Zelle 101 der Eintrag identisch ist mit der Dropdownliste C19-C26 dann soll ein Eintrag möglich sein.
Ich habe es mit einer IF Funktion versucht, jedoch beisse ich mir die Zähne mit den 8 dropdownlisten aus.
Könnte mir jemand bitte einen Denkanstoss geben?
Tausend Dank
Oli
-----------------------------------------------------------------------------------
Private Sub cmdUpdateGrid_Click()
Dim iTotalEmployees As Integer
Dim iRow As Integer
Dim iColumn As Integer
Dim iCurrentRow As Integer
Dim iClearGridRow As Integer
Dim iClearGridColumn As Integer
Dim iRowCounter As Integer
iTotalEmployees = Sheet2.Cells(1, 2).Value
iCurrentRow = 3
'* Blank out grid
iClearGridColumn = 3
For X = 0 To 2
iClearGridRow = 5
For y = 0 To 2
Sheet3.Cells(iClearGridRow, iClearGridColumn).Value = ""
iClearGridRow = iClearGridRow + 2
Next y
iClearGridColumn = iClearGridColumn + 1
Next X
'* Populate Grid
For X = 0 To iTotalEmployees - 1
Select Case Sheet2.Cells(iCurrentRow, 37).Value
Case "A"
iRow = 9
Case "B"
iRow = 7
Case "C"
iRow = 5
Case "D"
iRow = 7
Case "E"
iRow = 9
Case "F"
iRow = 5
Case "G"
iRow = 9
Case "H"
iRow = 5
Case "I"
iRow = 7
Case Else
iRow = 99
End Select
Select Case Sheet2.Cells(iCurrentRow, 37).Value
Case "A"
iColumn = 3
Case "B"
iColumn = 4
Case "C"
iColumn = 5
Case "D"
iColumn = 5
Case "E"
iColumn = 5
Case "F"
iColumn = 4
Case "G"
iColumn = 4
Case "H"
iColumn = 3
Case "I"
iColumn = 3
Case Else
iColumn = 99
End Select
If iRow 99 And iColumn 99 Then
'* Check for blanks
If Sheet3.Cells(iRow, iColumn).Value = "" Then
Sheet3.Cells(iRow, iColumn).Value = Sheet2.Cells(iCurrentRow, 2).Value & " " & _
Sheet2.Cells(iCurrentRow, 3).Value
Else
Sheet3.Cells(iRow, iColumn).Value = Sheet3.Cells(iRow, iColumn).Value & vbLf & _
Sheet2.Cells(iCurrentRow, 2).Value & " " & Sheet2.Cells(iCurrentRow, 3).Value
End If
End If
iCurrentRow = iCurrentRow + 1
Next X
'* Initialize Variables
iCurrentRow = 5
'* Resize Rows
For X = 0 To 2
Rows(iCurrentRow).EntireRow.AutoFit
iCurrentRow = iCurrentRow + 2
Next X
'* Reset Current Row
iCurrentRow = 5
'* Check for minimum size and resize if necessary
For X = 0 To 2
If Rows(iCurrentRow).RowHeight Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub