Ausgabe in Popup

Hallo liebe Leute,
ich habe folgendes Problem:
In meiner Exceltabelle werden Datumsangaben miteinander verglichen und sobald eine definierte Differenz auftritt ein Symbol (z.B. ein !) in einer Spalte (z.B. K) gesetzt.
Ich suche jetzt eine Funktion welche beim Starten der Tabelle die Spalte K nach gesetzten Symbolen dursucht. Findet diese Funktion ein oder mehrere gesetzte Symbole soll aus der/den entsprechenden Zeilen die Spalte A in einem popup ausgegeben werden.
Beispiel:
...A ...K
1 Aa ..!
2 Bb ..-
3 Cc ..!
4 Dd ..!
5 Ee ..-
Bei diesem Beispiel soll die Ausgabe im popup also wie folgt aussehen:
Aa
Cc
Dd
Ich hoffe mein Vorhaben ist verständlich geworden und ihr könnt mir weiterhelfen. In diesem Sinne schon mal Danke für eure Bemühungen.
Leon

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi,
kopiere den Code ins Modul deiner Tabelle
(Rechtsklick auf den Tabellenreiter,Code anzeigen auswählen und ins rechte Fenster einfügen)
!Beachte die Komentare im Code zu deiner eigenen Anpassung(Spalte, Startzeile etc.)

Option Explicit
Private Sub Worksheet_Activate()
Dim i&, lastRow&, strInfo$
Dim myCollection As New Collection, colObject, out
strInfo = "Hallo,folgende Daten wurden gefunden." 'anpassen
Const IN_COLUMN As Integer = 11, START_ROW As Integer = 2 ' Spalte & Startzeile anpassen
Const SIGN As String = "!" 'Zeichen anpassen
With ActiveSheet
lastRow = Application.Max(START_ROW, .Cells(.Rows.Count, IN_COLUMN).End(xlUp).Row)
For i = START_ROW To lastRow
If .Cells(i, IN_COLUMN) Like "*!" Then
myCollection.Add .Cells(i, IN_COLUMN).Text
End If
Next i
End With
For Each colObject In myCollection
out = out & colObject & Chr(13)
Next
MsgBox strInfo & Chr(13) & out
End Sub

VG
Steffen

' ********************************************************************** ' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...) ' ********************************************************************** Option Explicit Private Sub Workbook_Open() Dim rng As Range Dim strMsg As String With Sheets("Tabelle1") 'Tabellenname - Anpassen! For Each rng In Intersect(.UsedRange, .Columns(11)).Cells If rng = "!" Then strMsg = strMsg & .Cells(rng.Row, 1).Text & vbLf Next End With If Len(strMsg) Then MsgBox strMsg End Sub

Private Sub Workbook_Open() Dim rng As Range Dim strMsg As String, lngC As Long With Sheets("Tabelle1") 'Tabellenname - Anpassen! For Each rng In Intersect(.UsedRange, .Columns(11)).Cells If rng = "!" Then strMsg = strMsg & .Cells(rng.Row, 1).Text & vbLf lngC = lngC + 1 End If If lngC = 20 Then strMsg = strMsg & "Es sind noch weitere vorhanden ..." Exit For End If Next End With If Len(strMsg) Then MsgBox strMsg End Sub

Private Sub Workbook_Open() Dim rng As Range Dim strMsg As String, lngC As Long With Sheets("Tabelle1") 'Tabellenname - Anpassen! For Each rng In Intersect(.UsedRange, .Columns(11)).Cells If rng = "!" Then lngC = lngC + 1 If lngC > 20 Then strMsg = strMsg & "Es sind noch weitere vorhanden ..." Exit For Else strMsg = strMsg & .Cells(rng.Row, 1).Text & vbLf End If End If Next End With If Len(strMsg) Then MsgBox strMsg End Sub

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Ausgabe in Popup

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread