Seitenzahl X/Y beginnt auf Seite 2 aber Y rechnet Seite 1 fälschlicherweise mit

Das komplette Menü fehlt nicht. Ich kann im Menü auf Seitenzahl klicken, dann wähle ich z. B. aktuelle Position und dann erscheint "Weitere Seitenzahlen von Office.com".

Die Feldfunktion Page funktioniert, wie ich gerade festgestellt habe. Ich benötige allerdings die Formatvorlage "Seite X von Y" über das Menü.

Jupp, kannst Du als UDF oder von VBA aus nutzen. Die UDF muss dann als Matrixformel in einen entsprechend großen Bereich eingegeben werden.



Andreas.



Function MatrixOutsideIn(Bereich As Range, _

Optional ClearUnusedSpaceValue) As Variant

'Macht aus:

' Kasse A Bier 123,50 €

' Kasse B Bier 176,40 €

' Kasse C Bier 78,50 €

' Kasse D Bier 161,00 €

' Kasse A Wein 98,00 €

' Kasse B Wein 12,50 €

' Kasse C Wein 61,00 €

' Kasse D Wein 23,00 €

' Kasse A Saft 9,20 €

' Kasse B Saft 5,00 €

' Kasse C Saft 14,00 €

' Kasse D Saft 7,80 €

'dies:

' Bier Wein Saft

' Kasse A 123,50 € 98,00 € 9,20 €

' Kasse B 176,40 € 12,50 € 5,00 €

' Kasse C 78,50 € 61,00 € 14,00 €

' Kasse D 161,00 € 23,00 € 7,80 €

'Oder aus:

' StudyNumber SLT

' 10012 Cb

' 10012 MMc

' 10012 Cb

' 10012 Cb

' 11050 Jl

' 11050 Jl

' 11050 Ch

'dies:

' StudyNumber SLT1 SLT2 SLT3 SLT4

' 10012 Cb MMc Cb Cb

' 11050 Jl Jl Ch

Dim Arr(), Data, Items, Keys

Dim DictX As Object, DictY As Object

Dim X As Integer, Y As Long, i As Long, j As Long

If IsMissing(ClearUnusedSpaceValue) Then _

ClearUnusedSpaceValue = CVErr(xlErrNA)

Data = Bereich

Select Case UBound(Data, 2)

Case Is < 2

Exit Function

Case 2

Set DictY = CreateObject("Scripting.Dictionary")

X = 1

'Spalten und Zeilen ermitteln

For i = 2 To UBound(Data)

'Zeile schon vorhanden?

If Not DictY.Exists(Data(i, 1)) Then

'Nein, aufnehmen

Set DictX = New Collection

DictX.Add Data(i, 2)

DictY.Add Data(i, 1), DictX

Else

'Element hinzufügen

Set DictX = DictY.item(Data(i, 1))

DictX.Add Data(i, 2)

If DictX.Count > X Then X = DictX.Count

End If

Next

'Ausgabe dimensionieren

Y = DictY.Count

If TypeOf Application.Caller Is Range Then

'Ist der Eingabebereich größer als der Datenbereich?

With Application.Caller

If Y < .Rows.Count Then Y = .Rows.Count - 1

If X < .Columns.Count Then X = .Columns.Count - 1

End With

End If

'Ergebnis dimensionieren

ReDim Arr(0 To Y, 0 To X)

'Überschriften eintragen

Arr(0, 0) = Data(1, 1)

For X = 1 To UBound(Arr, 2)

Arr(0, X) = Data(1, 2) & X

Next

'Datenfelder eintragen

Items = DictY.Items

Keys = DictY.Keys

For Y = 1 To DictY.Count

'Elemente holen

Set DictX = Items(Y - 1)

'Name eintragen

Arr(Y, 0) = Keys(Y - 1)

'Elemente eintragen

For X = 1 To DictX.Count

Arr(Y, X) = DictX.item(X)

Next

'Unbenutzte Spalten löschen

For X = X To UBound(Arr, 2)

Arr(Y, X) = ClearUnusedSpaceValue

Next

Next

If TypeOf Application.Caller Is Range Then

'Unbenutzte Zeilen löschen

For Y = Y To UBound(Arr)

For X = LBound(Arr, 2) To UBound(Arr, 2)

Arr(Y, X) = ClearUnusedSpaceValue

Next

Next

End If

Case Is > 2

Set DictX = CreateObject("Scripting.Dictionary")

Set DictY = CreateObject("Scripting.Dictionary")

'Spalten und Zeilen ermitteln

For i = 1 To UBound(Data)

'Spalte schon vorhanden?

If Not DictX.Exists(Data(i, 2)) Then

'Nein, Index merken

X = X + 1

DictX.Add Data(i, 2), X

End If

'Zeile schon vorhanden?

If Not DictY.Exists(Data(i, 1)) Then

'Nein, Index merken

Y = Y + 1

DictY.Add Data(i, 1), Y

End If

Next

If TypeOf Application.Caller Is Range Then

'Ist der Eingabebereich größer als der Datenbereich?

With Application.Caller

If Y < .Rows.Count Then Y = .Rows.Count - 1

If X < .Columns.Count Then X = .Columns.Count - 1

End With

End If

'Ergebnis dimensionieren

ReDim Arr(0 To Y, 0 To X)

If TypeOf Application.Caller Is Range Then

'Unbenutzte Bereiche löschen

With Application.Caller

If DictX.Count < .Columns.Count - 1 Then

'Unbenutzte Spaltenenden löschen

For Y = 0 To .Rows.Count - 1

For X = DictX.Count To .Columns.Count - 1

Arr(Y, X) = ClearUnusedSpaceValue

Next

Next

End If

If DictY.Count < .Rows.Count - 1 Then

'Unbenutzte Zeilenenden löschen

For X = 0 To .Columns.Count - 1

For Y = DictY.Count To .Rows.Count - 1

Arr(Y, X) = ClearUnusedSpaceValue

Next

Next

End If

End With

End If

'Links oben ist immer leer

Arr(0, 0) = ClearUnusedSpaceValue

'Datenfelder eintragen

For i = 1 To UBound(Data)

Y = DictY.item(Data(i, 1))

X = DictX.item(Data(i, 2))

Arr(Y, X) = Data(i, 3)

Next

'Spaltenüberschriften eintragen

Data = DictX.Keys

For i = 0 To DictX.Count - 1

Arr(0, i + 1) = Data(i)

Next

'Zeilenüberschriften eintragen

Data = DictY.Keys

For i = 0 To DictY.Count - 1

Arr(i + 1, 0) = Data(i)

Next

End Select

MatrixOutsideIn = Arr

End Function

Wir verwenden einen Übersetzungsdienst, um unsere Benutzer zu unterstützen. Bitte entschuldigen Sie grammatikalische Fehler.
<br />

Der Fehler bedeutet, dass die Argumente oder Parameter falsch sind.
Sie können sich auf das VBA-Beispielmakro unten beziehen.

Sub LogEst_Regression_Test()

Dim estim As Variant
Dim x() Als Variante, y() als Variante, z() als Variante
Dim epsilon als Double
Dim i As Integer
Randomisieren

"Wir füllen die Vektoren der Observablen
ReDim x(1 bis 20)
ReDim y(1 Bis 20)
ReDim z(1 Bis 20)
Für i = 1 bis 20
epsilon = i * Rnd 'wir definieren einen Fehler proportional zu x
x(i) = i
y(i) = 3 * 2 ^ i + epsilon
z(i) = Log(y(i))
Weiter i

"Schätzung durch die LogEst-Regressionsmethode
estim = WorksheetFunction.LogEst(y, x, True, True)
Debug.Print estim(1, 1), estim(1, 2), estim(3, 1) 'zeigt die Koeffizienten B, A und R2 an

Ende Sub

Was bedeutet das ByVal... immer nach dem Sub?

Sub Main()

Dim x As Integer, y As Integer

x = 1

y = 1

Addiere x, y

Debug.Print x, y

End Sub

Private Sub Addiere(ByVal a As Integer, ByRef b As Integer)

a = a + 1

b = b + 1

End Sub

Lass Main laufen und kuck in's Direktfenster, dann fällt der Groschen. ;-)

Andreas.

Danke für die Antwort. Wie man eine 2. y-Achse öffnet weiß ich. Ich möchte 4 Achsen haben: 2 y- und 2 x-Achsen. Wie erstelle ich eine 2. x-Achse oben im Diagram ?

Vielen Dank