AW: ID Click
16.08.2018 14:15:24
Sepp
Hallo Antonio,
ein etwas anderer Ansatz.
Microsoft Excel Objekt Tabelle1
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const cstrRange As String = "D2:P7"
Const cstrInputRange As String = "H10:P15"
Dim rng As Range, varRet As Variant
If Not Intersect(Target, Range(cstrRange)) Is Nothing Then
If Target.Count = 1 Then
If Application.CountA(Range(cstrInputRange)) = Range(cstrInputRange).Count Then
MsgBox "Aus die Maus!"
Else
Set rng = FirstEmptyCell(Range(cstrInputRange), , True)
varRet = Application.Match(Target, Range("A:A"), 0)
If IsNumeric(varRet) Then
rng = Cells(varRet, 6)
End If
End If
Else
MsgBox "Mehr als eine Zelle ausgewählt!"
End If
End If
End Sub
Private Function FirstEmptyCell(Target As Range, Optional Reverse As Boolean = False, Optional byCol As Boolean = False) As Range
Dim vntRet As Variant, strRef As String
With Target.Areas(1)
strRef = "'" & .Parent.Name & "'!" & .Address
If byCol Then
vntRet = Evaluate(IIf(Reverse, "MAX", "MIN") & "(IF(" & strRef & "="""",COLUMN(" & strRef & _
")+ROW(" & strRef & ")*10^-6))")
Else
vntRet = Evaluate(IIf(Reverse, "MAX", "MIN") & "(IF(" & strRef & "="""",ROW(" & strRef & _
")+COLUMN(" & strRef & ")*10^-6))")
End If
If IsError(vntRet) Or vntRet = 0 Then Exit Function
If byCol Then
Set FirstEmptyCell = .Cells(CDbl("0," & Split(vntRet, ",")(1)) / 10 ^ -6 - .Rows(1).Row + 1, _
CLng(Split(vntRet, ",")(0)) - .Columns(1).Column + 1)
Else
Set FirstEmptyCell = .Cells(CLng(Split(vntRet, ",")(0)) - .Rows(1).Row + 1, _
CDbl("0," & Split(vntRet, ",")(1)) / 10 ^ -6 - .Columns(1).Column + 1)
End If
End With
End Function
VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0