Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1560to1564
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

Zellen verschieben

Zellen verschieben
30.05.2017 08:06:54
Kurt
Nochmal der Versuch diesmal mit Datei, da es beim letzten Mal ein bisschen unklar war.
Mein Problem:
Ich habe eine Loop Schleife geschrieben, die in einer Spalte Zeile für Zeile die Zellen ausliest und die Werte in Outlook einträgt. Das ganze läuft solange ab bis das Wort "Ende" in einer Zelle steht. Also z.B von "C5" bis "C200". Jetzt habe ich aber auch noch in den Spalten D-R Werte stehen, die mit der selben Schleife ausgelesen und übertragen werden sollen. Hier ist mein Problem.
Wie schaffe ich es auf eine elegante Art und Weise, dass das Makro sobald es bei der Zelle mit dem "Ende" ankommt, in die erste Zelle der nächsten Spalte springt und dass ganze am besten auch solang bis "Ende" in der ersten Zelle steht, um die leichter Änderungen an der Tabelle durchführen zu können?
Ich hab im Moment einfach die Schleife 15mal untereinander stehen und am Anfang nur jeweils das Range auf die nächste Spalte angepasst. Funktioniert zwar ist aber nicht schön.
Wäre schön wenn hier jemand eine bessere Lösung weiß.
Meine Tabelle mit Code:https://www.herber.de/bbs/user/113881.xlsm
Gruß Kurt

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellen verschieben
30.05.2017 09:28:51
Kurt
Perfekt danke sieht doch gleich viel besser aus
AW: Zellen verschieben
30.05.2017 09:14:46
yummi
Hallo Kurt,
sry ich dachte ich schaffs noch vor dem meeting, war aber doch noch nicht ganz fertig, nimm bitte die Funktion so (rest bleibt so):

Private Sub CommandButton1_Click()
Dim objOutlook As Outlook.Application
Dim apptOutlook As Outlook.AppointmentItem
Dim letzteZeile As Long
Dim letzteSpalte As Integer
Dim s As Integer
Dim z As Long
letzteSpalte = BestimmeLetzteSpalte(ActiveSheet, 4)
For s = 2 To letzteSpalte
letzezeile = BestimmeLetzteZeile(ActiveSheet, s)
For z = 5 To letzteZeile
If ActiveSheet.Cells(z, s).Value  "" Then
Set objOutlook = CreateObject("Outlook.Application")
Set apptOutlook = objOutlook.CreateItem(olAppointmentItem)
With apptOutlook
.Subject = ActiveSheet.Cells(z, s).Value
.Start = Format(ActiveSheet.Cells(z, 1).Value, "dd.mm.yyyy") & " 08:00"
.Body = ActiveSheet.Cells(4, s).Value
.Duration = 60
.ReminderMinutesBeforeStart = 1440
.ReminderPlaySound = True
.ReminderSet = True
.Save
End With
End If
Next z
Next s
Set apptOutlook = Nothing
Set objOutlook = Nothing
MsgBox "Termine an Outlook übertragen!"
end sub

Gruß
yummi
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige