Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1492to1496
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Nach Dropdown Wert als Kommentar

Nach Dropdown Wert als Kommentar
11.05.2016 12:46:15
Tom
Hallo zusammen,
ist es möglich, dass der Wert einer Zelle als Kommentar dargestellt wird, nachdem ein Dropdownfeld ausgewählt wird?
Bsp-Datei anbei https://www.herber.de/bbs/user/105505.xlsx
Hier wird in A1 ein Wert asugewählt, der in V2:v10 hinterlegt ist.
Nun soll der Wert, der in A1 gewählt wurde z.B. V2 den Kommentar W2 enthalten.
Wer hat ne Lösung?
Danke vorab
TOM

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nach Dropdown Wert als Kommentar
11.05.2016 14:03:41
UweD
Hallo
- Rechtsclick auf den Tabellenblattreiter
- Code anzeigen
- Diesen Code dort reinkopieren

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("A1"), Target) Is Nothing And Target.Count = 1 Then
With Target
.ClearComments
.AddComment
.Comment.Visible = False
.Comment.Text Text:=WorksheetFunction.VLookup(Target, Range("V:W"), 2, 0)
End With
End If
End Sub

Gruß UweD
Über Rückmeldungen würde ich mich freuen

AW: Nach Dropdown Wert als Kommentar
11.05.2016 14:10:43
Tom
Perfekt. Vielen Dank!!!!! :-)
Gruß
TOM

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

Anzeige
AW: Nach Dropdown Wert als Kommentar
11.05.2016 14:23:21
Tom
Auswahlfeldist zudem B1 nicht A1 - sorry :-(

AW: Nach Dropdown Wert als Kommentar
11.05.2016 14:40:57
UweD
Hi
ohne deinen Code zu checken....
so...

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
With Target
.ClearComments
.AddComment
.Comment.Visible = False
.Comment.Text Text:=WorksheetFunction.VLookup(Target, Range("V:W"), 2, 0)
End With
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

Anzeige
AW: Nach Dropdown Wert als Kommentar
11.05.2016 17:09:23
Tom
Jetzt passt es prima, danke!
TOM

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige