Excel Stock data Refinitiv/Eikon delay 2 hour to 1 day depending on exchange

Das schaut gut aus und würde mir als Lösung vollkommen ausreichen.

Das ist alles was Du zu sagen hast? Na denn...

Option Explicit

Sub Main()

Dim Where As Range

Dim Data, Result

Dim Low As Double, High As Double

Dim i As Long, j As Long, f As Long, t As Long

Dim Count() As Byte

Set Where = Range("A1").CurrentRegion

With WorksheetFunction

Low = .Min(Where) * 1440

High = .Max(Where) * 1440

End With

Data = Where.Value2

ReDim Count(Low To High)

For i = 2 To UBound(Data)

f = Data(i, 1) * 1440

t = Data(i, 2) * 1440

For j = f To t

Count(j) = Count(j) + 1

Next

Next



Data = CreateTimeLine("n", Low / 1440, High / 1440)

ReDim Result(1 To High - Low + 1, 1 To 2)

f = Low

t = LBound(Data)

For i = LBound(Result) To UBound(Result)

Result(i, 1) = Data(t)

Result(i, 2) = Count(f)

f = f + 1

t = t + 1

Next



Range("D1:E1") = Array("Zeit", "Anzahl")

Range("D2").Resize(UBound(Result), UBound(Result, 2)).Value = Result

End Sub

Function CreateTimeLine(ByVal Interval As String, ByVal Date1 As Date, ByVal Date2 As Date) As Variant

'Creates an array with date values from Date1 to Date2 in Interval

Dim Result() As Double, Frac As Double, i As Long, c As Long

Select Case LCase(Left$(Interval, 1))

Case "y": Interval = "yyyy"

Case "w": Interval = "ww"

End Select

c = DateDiff(Interval, Date1, Date2, vbUseSystemDayOfWeek, vbUseSystem)

ReDim Result(0 To c)

Result(0) = Date1

Select Case LCase(Left$(Interval, 1))

Case "q"

'Quarter

Frac = Date1 - Int(Date1)

For i = 1 To c

Result(i) = DateSerial(Year(Result(i - 1)), Month(Result(i - 1)) + 3, Day(Result(i - 1))) + Frac

Next

Case "w"

'Week

For i = 1 To c

Result(i) = Result(i - 1) + 7

Next

Case "y"

'Year

Frac = Date1 - Int(Date1)

For i = 1 To c

Result(i) = DateSerial(Year(Result(i - 1)) + 1, Month(Result(i - 1)), Day(Result(i - 1))) + Frac

Next

Case "m"

'Month

Frac = Date1 - Int(Date1)

For i = 1 To c

Result(i) = DateSerial(Year(Result(i - 1)), Month(Result(i - 1)) + 1, Day(Result(i - 1))) + Frac

Next

Case "d"

'Day

Frac = Date1 - Int(Date1)

For i = 1 To c

Result(i) = DateSerial(Year(Result(i - 1)), Month(Result(i - 1)), Day(Result(i - 1)) + 1) + Frac

Next

Case "h"

'Hour

For i = 1 To c

Result(i) = Int(Result(i - 1)) + TimeSerial(Hour(Result(i - 1)) + 1, Minute(Result(i - 1)), Second(Result(i - 1)))

Next

Case "n"

'Minute"

For i = 1 To c

Result(i) = Int(Result(i - 1)) + TimeSerial(Hour(Result(i - 1)), Minute(Result(i - 1)) + 1, Second(Result(i - 1)))

Next

Case "s"

'Second

For i = 1 To c

Result(i) = Int(Result(i - 1)) + TimeSerial(Hour(Result(i - 1)), Minute(Result(i - 1)), Second(Result(i - 1)) + 1)

Next

Case Else

Err.Raise 5, "CreateTimeLine", "Invalid Interval"

End Select

CreateTimeLine = Result

End Function

Könnte vielleicht sein das Excel den SpecialCellsBUG auch beim Kopieren hat, mach mal eine neue Datei und führe das Makro unten darin aus.

Es schreibt ein paar Daten in die Tabelle und setzt einen Autofilter.

Markiere alle sichtbaren Zellen und drückt STRG-C, kommt der Fehler?

Andreas.



Sub SpecialCellsBUG()

Dim Count As Long

Dim Data() As Variant

Dim i As Long

Dim R As Range



'Number of areas (8192 is the limit for Specialcells)

Count = 8193



ReDim Data(1 To Count * 2, 1 To 2)

For i = 1 To UBound(Data)

Data(i, 1) = i \ 2

Data(i, 2) = i Mod 2

Next

Data(1, 1) = "Nr"

Data(1, 2) = "Value"



'Cells.ClearContents

With Range("A1")

.Resize(UBound(Data), UBound(Data, 2)) = Data

.AutoFilter 2, 0

'Set R = .Parent.AutoFilter.Range

End With



'Set R = R.SpecialCells(xlCellTypeVisible)

'R.Select

End Sub

Did you try using the F12 key? (You may need to also press a Fn shift key, depending on how your manufacturer set up your computer.)

Kann ich nicht nachvollziehen, ich kann auch Diagramme mit weit aus mehr Daten erzeugen und drucken.

Mach mal eine neue Datei, führe das Makro unten darin aus und drucke das erzeugte Diagramm. Geht bei mir einwandfrei.

Andreas.



Sub Test()

Dim Data(0 To 5000, 1 To 2)

Dim i As Long

Dim C As Chart

Dim R As Range

Data(i, 1) = "A"

Data(i, 2) = "B"

For i = 1 To UBound(Data)

Data(i, 1) = "=SIN(BOGENMASS((ZEILE()-2)/" & UBound(Data) - 1 & "*360))"

Data(i, 2) = "=COS(BOGENMASS((ZEILE()-2)/" & UBound(Data) - 1 & "*360))"

Next

Range("A1").Resize(UBound(Data) + 1, UBound(Data, 2)).FormulaLocal = Data

Set R = Range("A1").CurrentRegion

Set C = Charts.Add

C.ChartType = xlLine

C.SetSourceData R, xlColumns

End Sub

Danke - ich meine aber, dass es doch mit Exchange 365 zusammenhängen muss:

Ursächlich für das Problem scheint mir zu sein, dass die Funktionalität "Send Email with delay" Outlook ins Schleudern bringt, wenn ich als Absender ein Freigabekonto verwende (ich habe auf das Konto vollen Zugriff):

1. Die E-Mail erscheint nicht im Postausgang (wo sie warten sollte, bis sie versandt werden kann)

2. Die E-Mail wird offenbar dennoch zum vorgesehenen Zeitpunkt abgesandt

3. Seitdem ich das Problem gem. Nr. 1 und 2 erstmalig hatte, funktioniert die Funktionalität "Send Email with delay" überhaupt nicht mehr (weder für mein ureigenes Exchange-Postfach, noch für andere IMAP-Postfächer.

Hinweis: Ich benutze Outlook 2016.