Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 12:56:25
Werte von Kunden und Artikel stehen untereinander
25.04.2024 12:55:42
Funktionsparameter auslesen
25.04.2024 11:49:37
Array verwenden
25.04.2024 10:38:52
Bedingte Formatierung per VBA / MaxPoint
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1064to1068
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1064to1068
1064to1068
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

@ Tino -> brauche Deine Hilfe

@ Tino -> brauche Deine Hilfe
06.04.2009 21:18:30
Markus
Hallo Tino,
ich brauche nochmals Deine Hilfe. Ich möchte aus Excel "auf Knopfdruck" Mails an verschiedene Mitarbeiter versenden. Die E-Mail-Adressen befinden sich in der Datei in P2:P15.
Jeder Mitarbeiter soll einmal seine eigenen Vorgangsdurchschnitt für das Quartal 1 und den Gruppendurchschnitt mitgeteilt bekommen. Ich habe dazu mit viel Hilfe aus dem Archiv eine Schleife gebastelt (siehe Makro in der Datei). Das klappt auch hervorragend. :-)
Nun sollen aber in der gleichen Mail auch die Daten der anderen Quartale genannt werden. Der Gruppendurchschnitt befindet sich immer in der gleichen Zeile jedes Quartals (z.B. K17, K36, K56 usw).
Für die Mitarbeiter muss dann mit einer Schleife immer auch die richtige Zeile ermittelt werden. Und hier scheitere ich.
z.B. für Mitarbeiter 1 wären es:
Q1 K2
Q2 K21
Q3 K41
Q4 K61
QG K81
Finde keine Lösung? Kannst Du mir helfen?
https://www.herber.de/bbs/user/61031.xls
Vielen Dank!
Viele Grüße
Markus

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: @ Tino -> brauche Deine Hilfe
06.04.2009 22:03:54
Tino
Hallo,
versuche es mal so, nicht genug getestet.
Sub Mail_versenden2()
   Dim oOL As Object
   Dim oOLMsg As Object
   Dim oOLRecip As Object
   Dim iRow As Integer
   Dim sRec As String, sSub As String, sBody As String
   iRow = 2
   Set oOL = CreateObject("Outlook.Application")
   Do Until IsEmpty(Cells(iRow, 16))
      sRec = Cells(iRow, 16).Value
      sSub = "Produktivität 2009"
      Set oOLMsg = oOL.CreateItem(0)
      With oOLMsg
         Set oOLRecip = .Recipients.Add(sRec)
         .Subject = sSub
         .body = "Hallo," & vbCrLf & "hier die Daten:" & String(2, vbCrLf) & _
          BodyText(Cells(iRow, 16)) & _
          String(4, vbCrLf) & "Viele Grüße" & vbCrLf & "Markus"
         .send
         oOLRecip.Resolve
      End With
      iRow = iRow + 1
   Loop
   Set oOL = Nothing
End Sub

Function BodyText(AdresseMail As String) As String
Dim vRow
Dim LCount As Long
Dim FindZelle As Range
 
vRow = Application.Match(AdresseMail, Columns(16), 0)

If IsNumeric(vRow) Then
vRow = vRow - 1
    With Application.WorksheetFunction
     For LCount = 1 To .CountIf(Columns(1), "*Quartal*")
      
      If FindZelle Is Nothing Then
       Set FindZelle = Columns(1).Find("*Quartal*", Cells(Rows.Count, 1), xlValues, 2, 1, 1, False, False, False)
      Else
       Set FindZelle = Columns(1).FindNext(FindZelle)
      End If

      BodyText = BodyText & FindZelle & ": " & _
      .Round(Cells(FindZelle.Row + vRow, 11), 2) & vbCrLf
     Next LCount
     
     Set FindZelle = Columns(1).Find("*Jahr*", Cells(Rows.Count, 1), xlValues, 2, 1, 1, False, False, False)
       
       BodyText = BodyText & FindZelle & " gesamt: " & _
      .Round(Cells(FindZelle.Row + vRow, 11), 2) & vbCrLf
    
    End With
End If

End Function


Gruß Tino

Anzeige
Klapp nicht so ganz...
06.04.2009 22:44:37
Markus
Hallo Tino,
es werden immer nur die Daten des Mitarbeiters 1 angezeigt, in der jeder der 14. Mails.
Bei den Werten selbst kommt bei Ganzzahlen kein Komma und Kommawerte. Wäre das möglich, dass auch bei Ganzzahlen z.B. 50 dann 50,00 kommen würde. Aber das ist nur Kosmetik.
Weiterhin hätte ich gerne die Durchschnittswerte der Gruppe. Kannst Du das nachfolgende irgendwo mit aufnehmen.
"1. Quartal 2009: " & Range("K17").Text & vbCrLf & _
"2. Quartal 2009: " & Range("K36").Text & vbCrLf & _
"3. Quartal 2009: " & Range("K56").Text & vbCrLf & _
"4. Quartal 2009: " & Range("K76").Text & vbCrLf & _
"Jahr 2009 gesamt: " & Range("K96").Text & vbCrLf & vbCrLf & _
Wichtig wäre der erste Punkt. Den Rest kriege ich bestimmt auch irgendwie hin. Aber beim ersten habe ich keine Chance, habe noch nicht einmal Deine Function so richtig verstanden. :-(
Viele Grüße
Markus
Anzeige
2. Versuch
06.04.2009 23:32:20
Tino
Hallo,
ok. versuchen wir es noch einmal.
Sub Mail_versenden2()
   Dim oOL As Object
   Dim oOLMsg As Object
   Dim oOLRecip As Object
   Dim iRow As Integer
   Dim sRec As String, sSub As String, sBody As String
   iRow = 2
   Set oOL = CreateObject("Outlook.Application")
   Do Until IsEmpty(Cells(iRow, 16))
      sRec = Cells(iRow, 16).Value
      sSub = "Produktivität 2009"
      Set oOLMsg = oOL.CreateItem(0)
      With oOLMsg
         Set oOLRecip = .Recipients.Add(sRec)
         .Subject = sSub
         
         .body = "Hallo," & vbCrLf & "hier die Daten:" & String(2, vbCrLf) & _
          BodyText(Cells(iRow, 16)) & _
          String(4, vbCrLf) & "Viele Grüße" & vbCrLf & "Markus"
         
         .Display
'         .send 
         oOLRecip.Resolve
         DoEvents
      End With
      iRow = iRow + 1
   Loop
   Set oOL = Nothing
End Sub

Function BodyText(ByRef AdresseMail As String) As String
Dim vRow
Dim LCount As Long
Dim FindZelle As Range
 
vRow = Application.Match(AdresseMail, Columns(16), 0)

If IsNumeric(vRow) Then
vRow = vRow - 1
    With Application.WorksheetFunction
     For LCount = 1 To .CountIf(Columns(1), "*Quartal*")
      
      If FindZelle Is Nothing Then
       Set FindZelle = Columns(1).Find("*Quartal*", Cells(Rows.Count, 1), xlValues, 2, 1, 1, False, False, False)
      Else
       Set FindZelle = Columns(1).FindNext(FindZelle)
      End If

      BodyText = BodyText & FindZelle & ": " & _
      Format(.Round(Cells(FindZelle.Row + vRow, 11), 2), "0.00") & "; " & _
      " Ø Gruppe: " & Format(.Round(FindZelle.Offset(16, 10), 2), "0.00") & vbCrLf
     
     Next LCount
     
     Set FindZelle = Columns(1).Find("*Jahr*", Cells(Rows.Count, 1), xlValues, 2, 1, 1, False, False, False)
       
       BodyText = BodyText & FindZelle & " gesamt: " & _
       Format(.Round(Cells(FindZelle.Row + vRow, 11), 2), "0.00") & "; " & _
       " Ø gesamt: " & Format(.Round(FindZelle.Offset(16, 10), 2), "0.00") & vbCrLf
    
    End With
End If

Set FindZelle = Nothing
End Function


Gruß Tino

Anzeige
AW: 2. Versuch
07.04.2009 08:23:26
Markus
Hallo Tino,
klappt immer noch nicht. Ich habe aber eine Lösung gefunden. Ich kopiere die Werte in die Spalten Q bis Z (mit Verknüfpung) und dann füge ich die Zeilen in die Mail ein. Das funktioniert o Wunder.
Danke auf alle Fälle für Deine Hilfe. Eine Frage habe ich noch. Wie kann ich den gesamten Text in der Schriftart "Courier New" und in Größe "11" anzeigen? Habe gesucht, aber immer nur Hinweise zu Html gefunden?!?
Viele Grüße
Markus
AW: 2. Versuch
07.04.2009 08:35:18
Tino
Hallo,
verstehe ich nicht, bei funktioniert es.
Mit der Schrift muss ich auch erst mal schauen.
Gruß Tino
AW: 2. Versuch
07.04.2009 08:44:33
Tino
Hallo,
es sind immer die Daten des entsprechenden Mitarbeiters
Userbild
Getestet unter xl2003 und xl2007, was sollte bei Dir anders sein?
Gruß Tino
Anzeige
AW: 2. Versuch
07.04.2009 09:18:28
Markus
Manno,
habe jetzt mal die Mail-Adressen geändert (hatte immer die gleiche) und jetzt funktioniert es. Bei ein und derselben kommen immer die gleichen Daten raus oder ich bin verwirrt oder müde oder Outlook verarscht mich.
Danke, klappt auf alle Fälle jetzt. Finde ich auch besser, da ich nicht jedes Mal die blöde Aufforderung in Outlook bekomme (das war bei meinem Makro grausam).
Tja, wenn Du mir jetzt noch zur Schriftart und Größe helfen könntest, wäre mein Tag gerettet. :-)
Vielen Dank für Deine abermals große Hilfe!
Viele Grüße
Markus
AW: 2. Versuch
07.04.2009 09:57:12
Tino
Hallo,
habe es mal mit htmlbody gemacht.
Die Schriftart wird eingestellt.
Bei der Schriftgröße, kenne ich den Befehl nicht für Größe genau auf 11,5.
Habe jetzt einfach die Schrift um einen Schritt größer gemacht wie die andere.
Sub Mail_versenden2()
   Dim oOL As Object
   Dim oOLMsg As Object
   Dim oOLRecip As Object
   Dim iRow As Integer
   Dim sRec As String, sSub As String, sBody As String
   iRow = 2
   Set oOL = CreateObject("Outlook.Application")
   Do Until IsEmpty(Cells(iRow, 16))
      sRec = Cells(iRow, 16).Value
      sSub = "Produktivität 2009"
      Set oOLMsg = oOL.CreateItem(0)
      With oOLMsg
         Set oOLRecip = .Recipients.Add(sRec)
         .Subject = sSub
          sBody = BodyText(Cells(iRow, 16))
         
         .htmlbody = "<p>Hallo," & "<br>" & "hier die Daten:</p>" & _
          sBody & _
          "<p>" & "<br>Viele Grüße" & "<br>" & "Markus</p>"
         
         .Display
'         .send 
         oOLRecip.Resolve
         DoEvents
      End With
      iRow = iRow + 1
   Loop
   Set oOL = Nothing
End Sub

Function BodyText(ByRef AdresseMail As String) As String
Dim vRow
Dim LCount As Long
Dim FindZelle As Range
 
vRow = Application.Match(AdresseMail, Columns(16), 0)

If IsNumeric(vRow) Then
vRow = vRow - 1
    With Application.WorksheetFunction
     For LCount = 1 To .CountIf(Columns(1), "*Quartal*")
      
      If FindZelle Is Nothing Then
       Set FindZelle = Columns(1).Find("*Quartal*", Cells(Rows.Count, 1), xlValues, 2, 1, 1, False, False, False)
      Else
       Set FindZelle = Columns(1).FindNext(FindZelle)
      End If

      BodyText = BodyText & FindZelle & ": " & _
      Format(.Round(Cells(FindZelle.Row + vRow, 11), 2), "0.00") & "; " & _
      " Ø Gruppe: " & Format(.Round(FindZelle.Offset(16, 10), 2), "0.00") & "<br>"
     
     Next LCount
     
     Set FindZelle = Columns(1).Find("*Jahr*", Cells(Rows.Count, 1), xlValues, 2, 1, 1, False, False, False)
       
       BodyText = BodyText & FindZelle & " gesamt: " & _
       Format(.Round(Cells(FindZelle.Row + vRow, 11), 2), "0.00") & "; " & _
       " Ø gesamt: " & Format(.Round(FindZelle.Offset(16, 10), 2), "0.00") & "<br>"
    
    End With
End If
BodyText = "<FONT FACE=""Courier New""><big>" & BodyText & "</big></FONT> "
Set FindZelle = Nothing
End Function


Gruß Tino

Anzeige
Super,
07.04.2009 19:50:31
Markus
vielen Dank für Deine Hilfe Tino!
Wieder ein Stück Erleichterung. :-)
Schöne Grüße
Markus

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige