HERBERS Excel-Forum - die Beispiele

Thema: Transponierte Werteübernahme

Home

Gruppe

Funktion

Problem

Werte sollen in einem zweiten Blatt transponiert dargestellt werden.

Lösung
Nur anhand einer Beipspielarbeitsmappe darstellbar.
StandardModule: Modul1

Sub WriteCalendar()
   Dim olApp As Outlook.Application
   Dim olNS As Outlook.NameSpace
   Dim olCal As Outlook.MAPIFolder
   Dim olApt As AppointmentItem
   Dim iRow As Integer
   Set olApp = CreateObject("Outlook.Application")
   Set olNS = olApp.GetNamespace("MAPI")
   On Error Resume Next
   Set olCal = olNS.GetDefaultFolder(olFolderCalendar).Folders("Training")
   If Err Then
      Set olCal = olNS.GetDefaultFolder(olFolderCalendar).Folders.Add("Training")
      Err.Clear
   End If
   iRow = 4
   Do Until IsEmpty(Cells(iRow, 1))
      Set olApt = olApp.CreateItem(olAppointmentItem)
      With olApt
         .Start = Cells(iRow, 1).Value + Cells(iRow, 3).Value
         .End = Cells(iRow, 1).Value + Cells(iRow, 4).Value
         .Subject = "Trainingstag"
         .Location = Cells(iRow, 5).Value
         .Body = Cells(iRow, 6).Value & " mitbringen"
         .BusyStatus = olBusy
         .ReminderMinutesBeforeStart = 120
         .ReminderSet = True
         .Save
         .Move olCal
      End With
      iRow = iRow + 1
   Loop
ERRORHANDLER:
   Set olApt = Nothing
   Set olCal = Nothing
   Set olNS = Nothing
   Set olApp = Nothing
End Sub

Sub ReadCalendar()
   Dim olApp As Outlook.Application
   Dim olNS As Outlook.NameSpace
   Dim olCal As Outlook.MAPIFolder
   Dim olApt As AppointmentItem
   Dim dat As Date
   Dim iRow As Integer
   Dim sTxt As String
   Application.ScreenUpdating = False
   On Error GoTo ERRORHANDLER
   Workbooks.Add 1
   Set olApp = CreateObject("Outlook.Application")
   Set olNS = olApp.GetNamespace("MAPI")
   Set olCal = olNS.GetDefaultFolder(olFolderCalendar).Folders("Training")
   ThisWorkbook.Worksheets(1).Range("A1:F3").Copy Range("A1")
   iRow = 4
   For Each olApt In olCal.Items
      dat = olApt.Start
      Cells(iRow, 1).Value = Fix(dat)
      Cells(iRow, 2).Value = Format(Fix(dat), "ddd")
      Cells(iRow, 3).Value = CDbl(dat) - Fix(dat)
      dat = olApt.End
      Cells(iRow, 4).Value = CDbl(dat) - Fix(dat)
      Cells(iRow, 5).Value = olApt.Location
      sTxt = olApt.Body
      Cells(iRow, 6).Value = Left(sTxt, InStr(sTxt, " ") - 1)
      iRow = iRow + 1
   Next olApt
   Columns("A").NumberFormat = "dd.mm.yy"
   Columns("C:D").NumberFormat = "hh:mm"
   Columns.AutoFit
ERRORHANDLER:
   Application.ScreenUpdating = True
   Set olApt = Nothing
   Set olCal = Nothing
   Set olNS = Nothing
   Set olApp = Nothing
End Sub

Beiträge aus dem Excel-Forum zu den Themen Funktion und INDEX

Copy funktioniert nur einmal Schreibschutz prüfen funktioniert nicht
Split-Funktion beim Einlesen TXT-Datei Match Funktion spinnt (?)
SVerweis funktioniert nicht PasteSpecial funktioniert nicht.
VERGLEICH/INDEX Formelproblem VBA-Code funktioniert nicht mit anderem Office
Hilfe bei der INDEX Funktion Index Formel_Berechnung nur bei bestimmten Wert
neues Aktien Index Problem Array - Index außerhalb des gültigen Bereichs
Zelladressen von FunktionsParametern ermitteln Index Vergleich Formel mit Summenformel
Matrixformel mit Summenfunktion Formel funktioniert nicht, SVerweis
Makro funktioniert nach Beenden von Excel nicht VLOOKUP auf Links funktioniert offline
Formel Index(RGP @DAVID Zwei SUMMEWENN funktionen verknüpfen
Zwei SUMMEWENN funktionen verknüpfen Polynomfunktion
Mit vba Funktionen in Excel Zellen Interior.ColorIndex
Rang-Funktion für Strings? Skript funktioniert nur auf einer seite?!?!
Hyperlink auf Excel-Datei funktioniert nicht Public Funktion / Variabel
VBA - Suchfunktion - Fehlermeldung Benutzerdefinierte Funktion
Userform mit Löschfunktion Frage zu Wenn Dann Funktion
Wenn-Funktion Colorindex Excel-Word RGB-Werte
Frage zur Funktion DISAGIO Funktion um Chart zu kreieren
Wenn-Funktion verschachtelt VBA Suchfunktion erweitern
Makro funktioniert nicht richtig Kombination von INDEX/Vergleich für Wertevergleich
zählenwenn-funktion mit mehreren kriterien Funktion SVERWEIS
Benutzerdefinierte Funktion in Open Office Funktion Dezimal -> Zeit/ Variablen-Deklaration
Probleme mit Textfunktionen Fehler, wenn Variable in Funktion
VBA-Funktion analog =ZELLE("Zeile") Gültigkeit funktioniert nicht!
Zellausrichtung funktioniert nicht WENN-Funktion