A | B | C | D | E | F | |
1 | 25,99 | 25,99 | Formeln | |||
2 | 13,78 | 13,78 | ||||
3 | 36,49 | 36,49 | ||||
4 | 13,78 | 36,49 | ||||
5 | 13,78 | 36,49 | ||||
6 | 25,99 | 25,99 | ||||
7 | 36,49 | 36,49 | ||||
8 | 25,99 | 36,49 | ||||
9 | 25,99 | 36,49 |
Rem Mxfml-fähige Fkt ermittelt BlattNamen aktMappe lt Vorgabe lfd Nrn
' Arg1: Einzel-RhfolgeNr bzw Vektor solcher Nrn, auch unzusammhängd
' als MxKonstante, ohne Arg1 wird d.Name d.letzt Blattes ermittelt.
' Vs1.0 -LSr -cd:20150509 -1pub:20150510herber -lupd:20150509n
Function ShName(Optional ByVal lfdNr)
Dim isVert As Boolean, aZr As Long, lZr As Long, shN() As String
On Error Resume Next
With ActiveWorkbook
If IsArray(lfdNr) Then
If IsError(LBound(lfdNr, 2)) Then
Else: Let isVert = UBound(lfdNr, 2) = 1
If Not isVert Then
lfdNr = WorksheetFunction.Transpose(lfdNr)
End If
lfdNr = WorksheetFunction.Transpose(lfdNr)
End If
aZr = LBound(lfdNr): lZr = UBound(lfdNr) - aZr
ReDim shN(lZr)
For lZr = 0 To lZr
shN(lZr) = .Sheets(lfdNr(aZr + lZr)).Name
Next lZr
If isVert Then
ShName = WorksheetFunction.Transpose(shN)
Else: ShName = shN
End If
ElseIf IsMissing(lfdNr) Then
ShName = .Sheets(.Sheets.Count).Name
Else: ShName = .Sheets(lfdNr).Name
End If
End With
End Function
Das Pgm ruft alle Blätter lt Argument lfdNr einzeln in ihrer Reihenfolge in der aktuellen Mappe auf. Diese können auch als Intervall (mit ZEILE/SPALTE) oder als Liste einzelner Nrn in Form eines MatrixKonstantenVektors angegeben wdn. Auf diese Weise können irrelevante Blätter ausgelassen wdn. Die WiedergabeOrientierung mehrzelliger MatrixFmln richtet sich nach der AusrichtungsForm des Arguments.
Option Explicit
Sub Liste()
Dim x&, i&
i = 1
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Liste"
For x = 1 To Worksheets.Count
If Worksheets(x).Name <> "Liste" Then
Worksheets("Liste").Cells(i, 1) = Worksheets(x).Name
Worksheets("Liste").Cells(i, 2) = Worksheets(x).Cells(33, 3)
i = i + 1
End If
Next
End Sub
Hier noch ohne Fehlerbehandlung!
Worksheets("Liste").Cells(i, 2) = Worksheets(x).Cells(33, 3)
Worksheets("Liste").Cells(i, 2).formular1c1 = "='" & Worksheets(x).Name & "'!R33C3"
A | B | C | D | E | F | |
1 | 25,99 | 25,99 | Formeln | |||
2 | 13,78 | 13,78 | ||||
3 | 36,49 | 36,49 | ||||
4 | 13,78 | 36,49 | ||||
5 | 13,78 | 36,49 | ||||
6 | 25,99 | 25,99 | ||||
7 | 36,49 | 36,49 | ||||
8 | 25,99 | 36,49 | ||||
9 | 25,99 | 36,49 |
Rem Mxfml-fähige Fkt ermittelt BlattNamen aktMappe lt Vorgabe lfd Nrn
' Arg1: Einzel-RhfolgeNr bzw Vektor solcher Nrn, auch unzusammhängd
' als MxKonstante, ohne Arg1 wird d.Name d.letzt Blattes ermittelt.
' Vs1.0 -LSr -cd:20150509 -1pub:20150510herber -lupd:20150509n
Function ShName(Optional ByVal lfdNr)
Dim isVert As Boolean, aZr As Long, lZr As Long, shN() As String
On Error Resume Next
With ActiveWorkbook
If IsArray(lfdNr) Then
If IsError(LBound(lfdNr, 2)) Then
Else: Let isVert = UBound(lfdNr, 2) = 1
If Not isVert Then
lfdNr = WorksheetFunction.Transpose(lfdNr)
End If
lfdNr = WorksheetFunction.Transpose(lfdNr)
End If
aZr = LBound(lfdNr): lZr = UBound(lfdNr) - aZr
ReDim shN(lZr)
For lZr = 0 To lZr
shN(lZr) = .Sheets(lfdNr(aZr + lZr)).Name
Next lZr
If isVert Then
ShName = WorksheetFunction.Transpose(shN)
Else: ShName = shN
End If
ElseIf IsMissing(lfdNr) Then
ShName = .Sheets(.Sheets.Count).Name
Else: ShName = .Sheets(lfdNr).Name
End If
End With
End Function
Das Pgm ruft alle Blätter lt Argument lfdNr einzeln in ihrer Reihenfolge in der aktuellen Mappe auf. Diese können auch als Intervall (mit ZEILE/SPALTE) oder als Liste einzelner Nrn in Form eines MatrixKonstantenVektors angegeben wdn. Auf diese Weise können irrelevante Blätter ausgelassen wdn. Die WiedergabeOrientierung mehrzelliger MatrixFmln richtet sich nach der AusrichtungsForm des Arguments.
Option Explicit
Sub Liste()
Dim x&, i&
i = 1
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Liste"
For x = 1 To Worksheets.Count
If Worksheets(x).Name <> "Liste" Then
Worksheets("Liste").Cells(i, 1) = Worksheets(x).Name
Worksheets("Liste").Cells(i, 2) = Worksheets(x).Cells(33, 3)
i = i + 1
End If
Next
End Sub
Hier noch ohne Fehlerbehandlung!
Worksheets("Liste").Cells(i, 2) = Worksheets(x).Cells(33, 3)
Worksheets("Liste").Cells(i, 2).formular1c1 = "='" & Worksheets(x).Name & "'!R33C3"