Option Explicit
 
Option Base 1
 
Private Type typPunkt
   x As Long
   y As Long
End Type
 
 
Public Sub Speichern()
Dim iX As Integer, iY As Integer
Dim i As Integer, ii As Integer
Dim iXTabMax As Integer, iYTabMax As Integer
Dim lVSatz() As typPunkt
 
iX = 3
iY = 5
With Worksheets("Tabelle1")
   Do Until .Cells(5, iX).Value = ""
      iXTabMax = (iX - 2) \ 2
      iX = iX + 1
   Loop
 
   Do Until .Cells(iY, 3).Value = ""
      iYTabMax = iY - 4
      iY = iY + 1
   Loop
 
   If iXTabMax > 0 And iYTabMax > 0 Then
      ReDim lVSatz(iXTabMax, iYTabMax)
      iY = 5
      For i = 1 To iYTabMax
         iX = 3
         For ii = 1 To iXTabMax
            lVSatz(ii, i).x = CLng(.Cells(iY, iX).Value)
            iX = iX + 1
            lVSatz(ii, i).y = CLng(.Cells(iY, iX).Value)
            iX = iX + 1
         Next ii
         iY = iY + 1
      Next i
   End If
End With
 
' wird im "CommonDialog" auf "Abbrechen" geklickt,
' wird (wenn CancelError = True ist) ein Laufzeitfehler ausgelöst.
On Error Resume Next
With UserForm1.CommonDialog1
   .CancelError = True
   ' Hinweis, falls Datei bereits vorhanden
   ' weitere Flags-Eigenschaften finden Sie in der MSDN
   .Flags = cdlOFNOverwritePrompt
 
   ' Filter setzen - hier wird festgelegt, unter welchem
   ' Format eine Datei gespeichert wird.
   .Filter = "Parameter (*.prm)|*.prm"
 
   ' Dialogfeld Speichern anzeigen
   .ShowSave
   '
   If .Filename <> "" Then
      SaveArray .Filename, lVSatz
   End If
 
End With
End Sub
 
 
Public Sub Oeffnen()
Dim i As Integer, ii As Integer
Dim iX As Integer, iY As Integer
Dim iXMax As Integer, iYMax As Integer
Dim lVSatz() As typPunkt
 
' wird im "CommonDialog" auf "Abbrechen" geklickt,
' wird (wenn CancelError = True ist) ein Laufzeitfehler ausgelöst.
On Error Resume Next
With UserForm1.CommonDialog1
   .CancelError = True
   ' Filter setzen - hier wird festgelegt, mit welchem Format
   ' eine Datei geöffnet wird.
   .Filter = "Parameter (*.prm)|*.prm"
 
   ' Dialogfeld Öffnen anzeigen
   .ShowOpen
 
   If .Filename <> "" Then
      OpenArray .Filename, lVSatz
   End If
End With
 
   iXMax = UBound(lVSatz, 1)
   iYMax = UBound(lVSatz, 2)
 
With Worksheets("Tabelle1")
   iY = 5
   For i = 1 To iYMax
      iX = 3
      For ii = 1 To iXMax
         .Cells(iY, iX).Value = lVSatz(ii, i).x
         iX = iX + 1
         .Cells(iY, iX).Value = lVSatz(ii, i).y
         iX = iX + 1
      Next ii
   iY = iY + 1
   Next i
End With
 
End Sub
 
 
Public Sub SaveArray(ByVal sFile As String, tArray() As typPunkt)
Dim iFNr As Integer
Dim xDim As Long
Dim yDim As Long
 
Open sFile For Binary As #iFNr
   xDim = UBound(tArray, 1)
   yDim = UBound(tArray, 2)
   Put #iFNr, , xDim
   Put #iFNr, , yDim
   Put #iFNr, , tArray()
Close #iFNr
 
End Sub
 
Public Sub OpenArray(ByVal sFile As String, tArray() As typPunkt)
Dim iFNr As Integer
Dim xDim As Long
Dim yDim As Long
 
Open sFile For Binary As #iFNr
   Get #iFNr, , xDim
   Get #iFNr, , yDim
 
   ReDim tArray(xDim, yDim)
   Get #iFNr, , tArray()
Close #iFNr
End Sub