PDA

View Full Version : Exporting an multidimensional array from an Ecxel file to a new Excel file (.xls)



sebbastiannn
05-12-2019, 07:30 AM
Hey, guys,

I'm a beginner at VBA in Excel, so unfortunately I quickly reached the limits of my knowledge.

A little background:
I use a laser to measure speed fields in a pipe. For this purpose, an Excel calculation was made which converts the pipe positions into the position that the laser has to move to.
There is the X Y and Z axis here. So 3 columns.
The whole thing is limited to 100 lines because nobody enters so many values.

The software of the laser has the option to upload files via "Import Mesh" (.xls), so that you do not have to transfer everything individually into the software.
However in the new file in column A the X coordinate must be column B the Y and column C the Z coordinate.

So far so good.

The files to be exported can be found in column 9 - 11 from line 2.
e.g. in this format
123
456
789

I have proceeded in such a way that I first let myself read in how big the array is at all and is then fixed on it. That works well... may not be nice but it works.

Then I create a new document with the name Export.xls.
and export the array to the new file.

My problem is that it doesn't output it in the new file as above, it looks like this:
1
2
3
4
5
6
7
8
9

So what I miss is something that makes it stand next to each other and not everything among each other:( I have already searched a few forums and watched videos but not found. Bzw nothing found what I understand ...:banghead:
Since I am a beginner I would still like to leave it as simple as possible:)

Here still the source code:




Option Explicit
Sub InformationenExportieren()

'Variablen definieren
Dim Zieldatei As String 'Speicherort der Text Datei
Dim p As Integer
Dim i As Integer, j As Integer 'Schleifenvariable
Dim size

Dim A()

'einzählen welche Array größe
For p = 2 To 100

If Cells(p, 9).Value = "" Then
Exit For
Else

size = size + 1
End If
Next

'einlesen des Array
ReDim A(size - 1, 2)

For i = 0 To size - 1
For j = 0 To 2

A(i, j) = Cells(i + 2, j + 9).Value

Next j

Next i


'Fehlermarke einfügen
On Error GoTo FehlerMarke

'Tabellenblattaktivieren
ThisWorkbook.Worksheets("waagerechtes Rohr").Activate

'ZielDatei erstellen
Zieldatei = ThisWorkbook.Path & "\Export.xls"

'ZielDatei öffnen
Open Zieldatei For Output As #1

'Information in Zieldatei einfügen

For j = 0 To 2

For i = 0 To size - 1

Print #1, A(i, j)

Next i

Next j


'Zieldatei schließen
Close #1

Exit Sub

FehlerMarke:
MsgBox Err.Description

End Sub


Sorry for my german comments

p45cal
05-12-2019, 01:01 PM
As a possible starter, try:
Sub InformationenExportieren3()
With ActiveSheet
Set NewWkBk = Workbooks.Add(xlWBATWorksheet)
.Range(.Cells(2, 9), .Cells(2, 9).End(xlDown)).Resize(, 3).Copy NewWkBk.Sheets(1).Cells(1)
End With
On Error GoTo FehlerMarke
NewWkBk.SaveAs Filename:=ThisWorkbook.Path & "\Export3.xls", FileFormat:=xlExcel8 'note filename
NewWkBk.Close False
Exit Sub
FehlerMarke:
MsgBox Err.Description
End Sub