Spalte nach Text durchsuchen

Forumthread: Spalte nach Text durchsuchen

25.06.2004 08:39:10

Bearny

Hallo Excel Spezialisten
Habe wieder eine Frage:
Wie kann ich in einer Spalte nach "Text" durchsuchen?
Wenn ich einen Text finde, soll der Text übernommen werden und das Makro starten - wenn mehrere Texte vorkommen sollen diese alle weiterverarbeitet werden.
mfg. bearny

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Spalte nach Text durchsuchen

Rolf

Hi,
Kannst du das noch etwas genauer umschreiben?
1. Wilst du einen Beliebigen Text suchen, oder das Wort "Text"?
2. Wohin soll der Text übernommen werden? In eine andere Zelle,in eine Variable (VBA) im Makro?
3 "...Text übernommen werden und das Makro starten..." Hä? Also danach weitersuchen nach dem Wort bzw. dem Text?
Danke für Aufklärung...
Rolf

AW: Spalte nach Text durchsuchen

Rolf

Hi Bearny,
Vielleicht hilft dir das weiter:
Folgend Angewendet:
Öffne Extras-Makro-VisualBsic-Editor
Klicke im neuen Fenster auf Einfügen-Modul
Füge den ganzen unteren Text in dem Modul ein.


Sub Makro1()
Application.ScreenUpdating = False
Dim A, B
A = "Text"
Range("A1").Select 'A1 ist die Zelle mit der er Anfängt zu suchen
For i = 1 To 100 ' Sucht in den ersten 100 Zellen der Spalte A
If ActiveCell = A Then
B = B + 1
ActiveCell.Offset(1, 0).Activate
Else:
ActiveCell.Offset(1, 0).Activate
End If
Next i
Application.ScreenUpdating = True
MsgBox "Sie haben " & B & " Treffer!" 'Gibt die eine Box mit der Anzahl der Treffer aus
End Sub

Wenn es nicht klappen sollte, stell die Datei in's Netz,. dann werde ich shen, ob ich das für dich machen kann!
Rolf
PS: Is nicht ein Parademakro, aber wenigstens Funzt es...

AW: Spalte nach Text durchsuchen

25.06.2004 13:20:32

Bearny

Hallo!
Danke mal vorerst.
also in meiner spalte B stehen Zahlenwerte z.B. 360. nun wird nach gewissem ablauf der zeit dieser Wert in eine Spalte geschrieben (AG) --> diese Tabelle wird täglich ergänzt und somit können die zahlenwerte (diese sind unterschiedlich) auch fortlaufen ergänzt. nun will ich sobald in meiner Zelle (z.b. AG 245....) der Wert drin steht diesen wert nehmen und in meinem makro, welches ein email verschickt mit einbauen; d.h. der Empfänger soll den Wert erhalten der in AG... drin steht.
klingt ziemlich kompliziert - bin jedenfalls am anschlag mit meinen kenntnissen :-(
danke im voraus
hier noch das Makro für die mail versendung in der der Wert rein sollte:
'----------------------------------------------------------------------------------------------------
'-----------------------------------Mailversendung wenn Rückgabefrist versäumt wird------------------
'----------------------------------------------------------------------------------------------------
'
Option Explicit 'Anweisung --> erzwingt die Variablendeklaration
'----------------------------------------------------------------------------------------------------
'Variablendeklaration:
'---------------------
Dim VAR_ELAVOR As Variant 'Variabel für Erkennung ob Mail an El-Avor gesendet wurde
Dim VAR_Wirth As Variant 'Variabel für Erkennung ob Mail an Wirth gesendet wurde
Dim VAR_Höhner As Variant 'Variabel für Erkennung ob Mail an Höhner gesendet wurde
Dim VAR_Kurz As Variant 'Variabel für Erkennung ob Mail an Kurz gesendet wurde
Dim VAR_Rüegg As Variant 'Variabel für Erkennung ob Mail an Rüegg gesendet wurde
Dim VAR_Salvodelli As Variant 'Variabel für Erkennung ob Mail an Salvodelli gesendet wurde
Dim VAR_Osreinig As Variant 'Variabel für Erkennung ob Mail an Osreinig gesendet wurde
Dim VAR_Name As Variant 'Variabel für Erkennung an wen das email geschickt wurde
'----------------------------------------------------------------------------------------------------
'Abfrageroutine:
'---------------


Private Sub Worksheet_Calculate()
If [v7] >= 1 Then Call Wirth
If [w7] >= 1 Then Call Höhner
If [x7] >= 1 Then Call Kurz
If [y7] >= 1 Then Call Rüegg
If [z7] >= 1 Then Call Salvodelli
If [aa7] >= 1 Then Call Osreinig
End Sub

'----------------------------------------------------------------------------------------------------
'Mail-Abfrage für Wirth Patrick:
'-------------------------------
Sub Wirth()
If Range("AF8").Value Date Then
If VAR_Wirth = 0 Then
VAR_Wirth = 0
If VAR_Wirth = 0 Then Call Mail_Wirth

End If
ElseIf VAR_Wirth 10 Then
MsgBox ("Es wurde heute schon ein Mail an Patrick W. gesendet !")
End If

End Sub
'----------------------------------------------------------------------------------------------------
'Mail-Abfrage für Höhner Marcel:
'-------------------------------
Sub Höhner()
If Range("AF9").Value Date Then
If VAR_Höhner = 0 Then
VAR_Höhner = 0
If VAR_Höhner = 0 Then Call Mail_Höhner

End If
ElseIf VAR_Höhner 10 Then
MsgBox ("Es wurde heute schon ein Mail an Marcel H. gesendet !")
End If

End Sub
'----------------------------------------------------------------------------------------------------
'Mail-Abfrage für Kurz Andreas:
'-------------------------------
Sub Kurz()
If Range("AF10").Value Date Then
If VAR_Kurz = 0 Then
VAR_Kurz = 0
If VAR_Kurz = 0 Then Call Mail_Kurz

End If
ElseIf VAR_Kurz 10 Then
MsgBox ("Es wurde heute schon ein Mail an Andi K. gesendet !")
End If

End Sub
'----------------------------------------------------------------------------------------------------
'Mail-Abfrage für Rüegg Roland:
'------------------------------
Sub Rüegg()
If Range("AF11").Value Date Then
If VAR_Rüegg = 0 Then
VAR_Rüegg = 0
If VAR_Rüegg = 0 Then Call Mail_Rüegg

End If
ElseIf VAR_Rüegg 10 Then
MsgBox ("Es wurde heute schon ein Mail an Rolli R. gesendet !")
End If

End Sub
'----------------------------------------------------------------------------------------------------
'Mail-Abfrage für Salvodelli Mirco:
'-----------------------------------
Sub Salvodelli()
If Range("AF12").Value Date Then
If VAR_Salvodelli = 0 Then
VAR_Salvodelli = 0
If VAR_Salvodelli = 0 Then Call Mail_Salvodelli

End If
ElseIf VAR_Salvodelli 10 Then
MsgBox ("Es wurde heute schon ein Mail an Mirco S. gesendet !")
End If

End Sub
'----------------------------------------------------------------------------------------------------
'Mail-Abfrage für Osreinig Hermann:
'-----------------------------------
Sub Osreinig()
If Range("AF13").Value Date Then
If VAR_Osreinig = 0 Then
VAR_Osreinig = 0
If VAR_Osreinig = 0 Then Call Mail_Osreinig

End If
ElseIf VAR_Osreinig 10 Then
MsgBox ("Es wurde heute schon ein Mail an Hermann O. gesendet !")
End If

End Sub
'----------------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------------
'Mail an Patrick Wirth:
'----------------------
Sub Mail_Wirth()
If VAR_Wirth = 0 Then
MsgBox ("Die Rückgabefrist ist abgelaufen! Mail an Patrick W. senden?!")
Dim olAPP As Object
Set olAPP = CreateObject("Outlook.Application")
With olAPP.CreateItem(0)
'Empfänger
.Recipients.Add "Patrick.Wirth@stadlerrail.ch"
'Betreff
.Subject = "Rückmeldung"
'Nachricht
.Body = "Guten Tag Patrick" & Chr(13) & _
"Die siebentägige Frist für die Rückgabe der Rückmeldung ist abglelaufen!" & Chr(13) & _
"Wir bitten Sie das Formular so bald als möglich ins AVOR Büro zu bringen." & Chr(13) & _
"Mit freundlichen Grüssen, das AVOR-Team." & Chr(13) & Chr(13)
'Lesebestätigung ein
.ReadReceiptRequested = True
.Send
End With
Set olAPP = Nothing

VAR_ELAVOR = 1
VAR_Wirth = 10
VAR_Name = 1
Call Mail_El_AVOR
Range("AF8").Value = Date
Else
MsgBox ("Mail wurde heute bereits versendet !")
End If
End Sub
'----------------------------------------------------------------------------------------------------
'Mail an Marcel Höhner:
'----------------------
Sub Mail_Höhner()
If VAR_Höhner = 0 Then
MsgBox ("Die Rückgabefrist ist abgelaufen! Mail an Marcel H. senden?!")
Dim olAPP As Object
Set olAPP = CreateObject("Outlook.Application")
With olAPP.CreateItem(0)
'Empfänger
.Recipients.Add "Marcel.Hoehener@stadlerrail.ch@stadlerrail.ch"
'Betreff
.Subject = "Rückmeldung"
'Nachricht
.Body = "Guten Tag Marcel" & Chr(13) & _
"Die siebentägige Frist für die Rückgabe der Rückmeldung ist abglelaufen!" & Chr(13) & _
"Wir bitten Sie das Formular so bald als möglich ins AVOR Büro zu bringen." & Chr(13) & _
"Mit freundlichen Grüssen, das AVOR-Team." & Chr(13) & Chr(13)
'Lesebestätigung ein
.ReadReceiptRequested = True
.Send
End With
Set olAPP = Nothing

VAR_ELAVOR = 1
VAR_Höhner = 10
VAR_Name = 2
Call Mail_El_AVOR
Range("AF9").Value = Date
Else
MsgBox ("Mail wurde heute bereits versendet !")
End If
End Sub
'----------------------------------------------------------------------------------------------------
'Mail an Andi Kurz:
'------------------
Sub Mail_Kurz()
If VAR_Kurz = 0 Then
MsgBox ("Die Rückgabefrist ist abgelaufen! Mail an Andi K. senden?!")
Dim olAPP As Object
Set olAPP = CreateObject("Outlook.Application")
With olAPP.CreateItem(0)
'Empfänger
.Recipients.Add "Andreas.Kurz@stadlerrail.ch"
'Betreff
.Subject = "Rückmeldung"
'Nachricht
.Body = "Guten Tag Andi" & Chr(13) & _
"Die siebentägige Frist für die Rückgabe der Rückmeldung ist abglelaufen!" & Chr(13) & _
"Wir bitten Sie das Formular so bald als möglich ins AVOR Büro zu bringen." & Chr(13) & _
"Mit freundlichen Grüssen, das AVOR-Team." & Chr(13) & Chr(13)
'Lesebestätigung ein
.ReadReceiptRequested = True
.Send
End With
Set olAPP = Nothing

VAR_ELAVOR = 1
VAR_Kurz = 10
VAR_Name = 3
Call Mail_El_AVOR
Range("AF10").Value = Date
Else
MsgBox ("Mail wurde heute bereits versendet !")
End If
End Sub
'----------------------------------------------------------------------------------------------------
'Mail an Rolli Rüegg:
'--------------------
Sub Mail_Rüegg()
If VAR_Rüegg = 0 Then
MsgBox ("Die Rückgabefrist ist abgelaufen! Mail an Rolli R. senden?!")
Dim olAPP As Object
Set olAPP = CreateObject("Outlook.Application")
With olAPP.CreateItem(0)
'Empfänger
.Recipients.Add "Roland.Rüegg@stadlerrail.ch"
'Betreff
.Subject = "Rückmeldung"
'Nachricht
.Body = "Guten Tag Rolli" & Chr(13) & _
"Die siebentägige Frist für die Rückgabe der Rückmeldung ist abglelaufen!" & Chr(13) & _
"Wir bitten Sie das Formular so bald als möglich ins AVOR Büro zu bringen." & Chr(13) & _
"Mit freundlichen Grüssen, das AVOR-Team." & Chr(13) & Chr(13)
'Lesebestätigung ein
.ReadReceiptRequested = True
.Send
End With
Set olAPP = Nothing

VAR_ELAVOR = 1
VAR_Rüegg = 10
VAR_Name = 4
Call Mail_El_AVOR
Range("AF11").Value = Date
Else
MsgBox ("Mail wurde heute bereits versendet !")
End If
End Sub
'----------------------------------------------------------------------------------------------------
'Mail an Mirco Salvodelli:
'-------------------------
Sub Mail_Salvodelli()
If VAR_Salvodelli = 0 Then
MsgBox ("Die Rückgabefrist ist abgelaufen! Mail an Mirco S. senden?!")
Dim olAPP As Object
Set olAPP = CreateObject("Outlook.Application")
With olAPP.CreateItem(0)
'Empfänger
.Recipients.Add "Mirco.Salvodelli@stadlerrail.ch"
'Betreff
.Subject = "Rückmeldung"
'Nachricht
.Body = "Guten Tag Mirco" & Chr(13) & _
"Die siebentägige Frist für die Rückgabe der Rückmeldung ist abglelaufen!" & Chr(13) & _
"Wir bitten Sie das Formular so bald als möglich ins AVOR Büro zu bringen." & Chr(13) & _
"Mit freundlichen Grüssen, das AVOR-Team." & Chr(13) & Chr(13)
'Lesebestätigung ein
.ReadReceiptRequested = True
.Send
End With
Set olAPP = Nothing

VAR_ELAVOR = 1
VAR_Salvodelli = 10
VAR_Name = 5
Call Mail_El_AVOR
Range("AF12").Value = Date
Else
MsgBox ("Mail wurde heute bereits versendet !")
End If
End Sub
'----------------------------------------------------------------------------------------------------
'Mail an Hermann Osreinig:
'-------------------------
Sub Mail_Osreinig()
If VAR_Osreinig = 0 Then
MsgBox ("Die Rückgabefrist ist abgelaufen! Mail an Hermann O. senden?!")
Dim olAPP As Object
Set olAPP = CreateObject("Outlook.Application")
With olAPP.CreateItem(0)
'Empfänger
.Recipients.Add "Hermann.Osreinig@stadlerrail.ch"
'Betreff
.Subject = "Rückmeldung"
'Nachricht
.Body = "Guten Tag Hermann" & Chr(13) & _
"Die siebentägige Frist für die Rückgabe der Rückmeldung ist abglelaufen!" & Chr(13) & _
"Wir bitten Sie das Formular so bald als möglich ins AVOR Büro zu bringen." & Chr(13) & _
"Mit freundlichen Grüssen, das AVOR-Team." & Chr(13) & Chr(13)
'Lesebestätigung ein
.ReadReceiptRequested = True
.Send
End With
Set olAPP = Nothing

VAR_ELAVOR = 1
VAR_Osreinig = 10
VAR_Name = 6
Call Mail_El_AVOR
Range("AF13").Value = Date
Else
MsgBox ("Mail wurde heute bereits versendet !")
End If
End Sub
'----------------------------------------------------------------------------------------------------
'Mail (cc:) an Ronny Schwendener (Wirth):
'-------------------------------------
Sub Mail_El_AVOR()
If VAR_Name = 1 Then
MsgBox ("Mail an Ronny S. senden?!")
Dim olAPP As Object
Set olAPP = CreateObject("Outlook.Application")
With olAPP.CreateItem(0)
'Empfänger
.Recipients.Add "Ronny.Schwendener@stadlerrail.ch"
'Betreff
.Subject = "Rückmeldung"
'Nachricht
.Body = "Hallo Ronny" & Chr(13) & _
"Es wurde ein mail an Patrick Wirth gesendet" & Chr(13) & _
" " & Chr(13) & _
" " & Chr(13) & Chr(13)
'Lesebestätigung ein
.ReadReceiptRequested = True
.Send

End With
Set olAPP = Nothing
VAR_ELAVOR = 0
End If
'----------------------------------------------------------------------------------------------------
'Mail (cc:) an Ronny Schwendener (Höhner):
'-----------------------------------------
If VAR_Name = 2 Then
MsgBox ("Mail an Ronny S. senden?!")

Set olAPP = CreateObject("Outlook.Application")
With olAPP.CreateItem(0)
'Empfänger
.Recipients.Add "Ronny.Schwendener@stadlerrail.ch"
'Betreff
.Subject = "Rückmeldung"
'Nachricht
.Body = "Hallo Ronny" & Chr(13) & _
"Es wurde ein mail an Marcel Höhener gesendet" & Chr(13) & _
"" & Chr(13) & _
"" & Chr(13) & Chr(13)
'Lesebestätigung ein
.ReadReceiptRequested = True
.Send

End With
Set olAPP = Nothing
VAR_ELAVOR = 0

End If
'----------------------------------------------------------------------------------------------------
'Mail (cc:) an Ronny Schwendener (Kurz):
'----------------------------------------
If VAR_Name = 3 Then
MsgBox ("Mail an Ronny S. senden?!")

Set olAPP = CreateObject("Outlook.Application")
With olAPP.CreateItem(0)
'Empfänger
.Recipients.Add "Ronny.Schwendener@stadlerrail.ch"
'Betreff
.Subject = "Rückmeldung"
'Nachricht
.Body = "Hallo Ronny" & Chr(13) & _
"Es wurde ein mail an Andi Kurz gesendet" & Chr(13) & _
"" & Chr(13) & _
"" & Chr(13) & Chr(13)
'Lesebestätigung ein
.ReadReceiptRequested = True
.Send

End With
Set olAPP = Nothing
VAR_ELAVOR = 0

End If
'----------------------------------------------------------------------------------------------------
'Mail (cc:) an Ronny Schwendener (Rüegg):
'-----------------------------------------
If VAR_Name = 4 Then
MsgBox ("Mail an Ronny S. senden?!")

Set olAPP = CreateObject("Outlook.Application")
With olAPP.CreateItem(0)
'Empfänger
.Recipients.Add "Ronny.Schwendener@stadlerrail.ch"
'Betreff
.Subject = "Rückmeldung"
'Nachricht
.Body = "Hallo Ronny" & Chr(13) & _
"Es wurde ein mail an Rolli Rüegg gesendet" & Chr(13) & _
"" & Chr(13) & _
"" & Chr(13) & Chr(13)
'Lesebestätigung ein
.ReadReceiptRequested = True
.Send

End With
Set olAPP = Nothing
VAR_ELAVOR = 0

End If
'----------------------------------------------------------------------------------------------------
'Mail (cc:) an Ronny Schwendener (Salvodelli):
'---------------------------------------------
If VAR_Name = 5 Then
MsgBox ("Mail an Ronny S. senden?!")

Set olAPP = CreateObject("Outlook.Application")
With olAPP.CreateItem(0)
'Empfänger
.Recipients.Add "Ronny.Schwendener@stadlerrail.ch"
'Betreff
.Subject = "Rückmeldung"
'Nachricht
.Body = "Hallo Ronny" & Chr(13) & _
"Es wurde ein mail an Mirco Salvodelli gesendet" & Chr(13) & _
"" & Chr(13) & _
"" & Chr(13) & Chr(13)
'Lesebestätigung ein
.ReadReceiptRequested = True
.Send

End With
Set olAPP = Nothing
VAR_ELAVOR = 0

End If
'----------------------------------------------------------------------------------------------------
'Mail (cc:) an Ronny Schwendener (Osreinig):
'-------------------------------------------
If VAR_Name = 6 Then
MsgBox ("Mail an Ronny S. senden?!")

Set olAPP = CreateObject("Outlook.Application")
With olAPP.CreateItem(0)
'Empfänger
.Recipients.Add "Ronny.Schwendener@stadlerrail.ch"
'Betreff
.Subject = "Rückmeldung"
'Nachricht
.Body = "Hallo Ronny" & Chr(13) & _
"Es wurde ein mail an Hermann Osreinig gesendet" & Chr(13) & _
"" & Chr(13) & _
"" & Chr(13) & Chr(13)
'Lesebestätigung ein
.ReadReceiptRequested = True
.Send

End With
Set olAPP = Nothing
VAR_ELAVOR = 0

End If
End Sub
'----------------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------------
'THE END

Kann leider nicht helfen!

Rolf

Hallo Bearny,
Leider bin ich auch nicht so gut, dass ich mir erlauben könnte, zu sagen, wie man das macht. Aber ich bin sicher, dass es in diesem Forum Leute gibt, die das sicher hinkriegen! Und dann solltest du noch den Level ändern! (Excel gut-VBA Nein scheint ja nicht ganz zuzutreffen!)
Ich hoffe, es findet sich jemand, der sich besser damit auskennt!
Gruss
Rolf

Beliebteste Forumthreads (12 Monate)

Forumthread: Spalte nach Text durchsuchen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Spalte nach Text durchsuchen

Forumthread: Spalte nach Text durchsuchen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread