AW: Nach Dropdown Wert als Kommentar
11.05.2016 14:20:13
Tom
Hallo Uwe,
war zu voreilig ....
In der Bsp Mappe funktioniert es einwandfrei.
In der Originalmappe habe ich aber schon
Private Sub Worksheet_Change(ByVal Target As Range), und dann "schimpft" der Editor.
Unten der Originalcode komplett (wußte nicht dass es wichtig ist ...).
Kannst du ihn mir anpassen - kann es zwar immer einigermaßen nachvollziehen, aber bin in VBA _
nicht ganz so fit, um diese Codes alleine anzupassen oder zu schreiben.
Danke nochmal.
TOM
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim varRet As Variant
Dim lngC As Long, lngRow As Long
Dim CalculationMode As Long
On Error GoTo ErrorHandler
With Application
' .ScreenUpdating = False
.EnableEvents = False
CalculationMode = .Calculation
.Calculation = xlManual
.DisplayAlerts = False
End With
If Target.Address(0, 0) = "B1" Then
Me.Range("C2:U" & Application.Max(2, Me.Cells(Me.Rows.Count, 2).End(xlUp).Row)).ClearContents
For Each rng In Me.Range("B2:B" & Application.Max(2, Me.Cells(Me.Rows.Count, 2).End(xlUp).Row) _
)
If rng "" Then
If SheetExist(rng.Text) Then
MsgBox rng.Text
With Sheets(rng.Text)
varRet = Application.Match(Target, .Columns(1), 0)
If IsNumeric(varRet) Then
lngRow = varRet
For lngC = 3 To 21
varRet = Application.Match(Me.Cells(1, lngC), .Rows(1), 0)
If IsNumeric(varRet) Then
Me.Cells(rng.Row, lngC) = .Cells(lngRow, varRet)
Else
Me.Cells(rng.Row, lngC) = "#NA"
End If
Next
End If
End With
End If
End If
Next
End If
ErrorHandler:
With Err
If .Number 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'nn'" & vbLf & String(25, "") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, 81968, "VBA - Fehler in Prozedur - collectData", .HelpFile, . _
HelpContext
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalculationMode
.DisplayAlerts = True
.StatusBar = False
End With
End Sub
Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
Dim wks As Object
On Error GoTo ErrorHandler
If Wb Is Nothing Then Set Wb = ThisWorkbook
For Each wks In Wb.Sheets
If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
Next
ErrorHandler:
SheetExist = False
End Function