Help met Array

Status
Niet open voor verdere reacties.

toshibaA110

Gebruiker
Lid geworden
3 sep 2007
Berichten
8
Hoi,

Wie kan mij uitleggen wat dit inhoud ?

Workbooks.OpenText FileName:=InputFileName, Origin:= _
xlWindows, StartRow:=1, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(7, 2), _
Array(8, 2), Array(10, 2), _
Array(10, 2), Array(15, 9), _
Array(30, 2), Array(39, 2), _
Array(45, 2), Array(55, 2), _
Array(61, 5), Array(67, 2), _
Array(69, 5), Array(75, 1), _
Array(75, 1), Array(82, 1)

Wat ik hieruit begrijp:

een input file, eerste veld begint op positie 0 en is van het type 2 (ik weet niet wat die types betekenen). Maar waar stopt het veld ?
2e veld begint op positie 7, type 2, hoeveel posities ? enz.

Type 5 is schijnbaar een datum, en type 1 alphanummeriek

Stukje input bestand:

A 21996 DEKPENV CIP-DE KRAU0496917613.0 69635475.6 96062785160627380 13 E

A 21997 DEKPENV CIP-DE KRAU0796917614.8 69637007.7 96062782160627760 13 E


Deze invoer wordt in een excel sheet gestopt.
Het eerste veld, vanaf 0, is 7 posities lang, en komt terecht in column A.
Maar verderop in de sheet worden er dingen door elkaar gegooid en ik snap er niets van.


Alvast bedankt.

Gr.
 
Hoe ben je aan die code gekomen? Macro recorder?

En hang anders eens die textfile bij, anders kunnen helpers hier ook niet veel doen.

Wigi
 
herkomst van de macro is onduidelijk. die bestond al en ik moet daar kolommen aan toevoegen.

dit is de volledige macro:

Option Explicit

Sub Auto_open()
'
' Macro for creating excel sheet
'
Call Reformat("c:\flop\JUN.CIP", "c:\flop\jun_new.xls")
'Application.Quit
End Sub


Sub Reformat(InputFileName As String, OutputFileName As String)
'
' Procedure for reformatting excel sheet.
'
Dim nRow As Integer
Dim Dummy As Integer

On Error GoTo err_opening_file
Workbooks.OpenText FileName:=InputFileName, Origin:= _
xlWindows, StartRow:=1, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(7, 2), _
Array(8, 2), Array(10, 2), _
Array(10, 2), Array(15, 9), _
Array(30, 2), Array(39, 2), _
Array(45, 2), Array(55, 2), _
Array(61, 5), Array(67, 2), _
Array(69, 5), Array(75, 1), _
Array(75, 1), Array(82, 1), _
Array(84, 9), Array(86, 2))
' On Error GoTo 0
' Convert strings to doubles in column G (Amount).
' This also changes the '.' sign in a value to the
' currently active decimal seperator.
nRow = 1
While (Cells(nRow, 1).Value <> "")
Cells(nRow, 8).Value = Val(Cells(nRow, 8).Value)
nRow = nRow + 1
Wend


' Reorder the collumns

Columns("K:K").Cut
Columns("M:M").Select
ActiveSheet.Paste

Columns("J:J").Cut
Columns("L:L").Select
ActiveSheet.Paste

Columns("H:H").Cut
Columns("J:J").Select
ActiveSheet.Paste

Columns("I:I").Cut
Columns("K:K").Select
ActiveSheet.Paste


' Enter formula to caculate due date into column H.
nRow = 1
While (Cells(nRow, 7).Value <> "")
Cells(nRow, 8).Formula = "=DATE(YEAR(R[0]C[-1])+R[0]C[+4]-1,MONTH(R[0]C[-1]),DAY(R[0]C[-1]))"
nRow = nRow + 1
Wend

' Enter formula to calculate next date into column G.
nRow = 1
While (Cells(nRow, 7).Value <> "")
Cells(nRow, 9).Formula = "=DATE(YEAR(R[0]C[-2])+R[0]C[+3],MONTH(R[0]C[-2]),DAY(R[0]C[-2]))"
nRow = nRow + 1
Wend


' Set the correct format for the collumns
Columns("G:G").EntireColumn.NumberFormat = "dd/mm/yyyy"
Columns("J:J").EntireColumn.NumberFormat = "dd/mm/yyyy"
Columns("H:H").EntireColumn.NumberFormat = "dd/mm/yyyy"
Columns("I:I").EntireColumn.NumberFormat = "dd/mm/yyyy"
Columns("K").NumberFormat = "#,##0.00"

' Insert header
Rows("1:1").Insert Shift:=xlDown
Range("A1").FormulaR1C1 = "A"
Range("B1").FormulaR1C1 = "B"
Range("C1").FormulaR1C1 = "C"
Range("D1").FormulaR1C1 = "D"
Range("E1").FormulaR1C1 = "E"
Range("F1").FormulaR1C1 = "F"
Range("G1").FormulaR1C1 = "Start Date"
Range("H1").FormulaR1C1 = "Due Date"
Range("I1").FormulaR1C1 = "Next Date"
Range("J1").FormulaR1C1 = "End Date"
Range("K1").FormulaR1C1 = "EUR"
Range("L1").FormulaR1C1 = "L"
Range("M1").FormulaR1C1 = "Type"


' Set font in header to bold

Range("A1:M1").Font.Bold = True


' Underline the header

With Range("A1:M1").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

' make all columns look neatly, straight and clean

Columns("A:N").EntireColumn.AutoFit
Range("A1").Select


' save this excel-sheet to the desktop

ActiveWorkbook.SaveAs FileName:=OutputFileName
ActiveWorkbook.Close

Exit Sub

err_opening_file:
On Error GoTo 0
Dummy = MsgBox("File with name '" + InputFileName + "' could not be opened.", vbOKOnly)
forced_end:
End Sub



dit is de input/text file, wat eigenlijk een excel sheet is, waar deze macro overheen gaat.

010403 DEMASSIVECIP-DE RPET0699201902.6 69933612.0 99061582190615350 10
A 21678 DEKPENV CIP-DE LUND0792201893.2 69232324.4 92062685120626705 17 E
A 21996 DEKPENV CIP-DE KRAU0496917613.0 69635475.6 96062785160627380 13 E
A 21997 DEKPENV CIP-DE KRAU0796917614.8 69637007.7 96062782160627760 13 E
A 23050 DEKPENV CIP-DE KRAU0796917612.2 69635511.6 96062782160627760 13 E



Output


010403 DE MASSI 99201902. 6 69933612. 0 15-06-1999 82 15-06-2019 350 10
A 21678 DE KPENV 92201893. 2 69232324. 4 26-06-1992 85 26-06-2012 705 17 E
A 21996 DE KPENV 96917613. 0 69635475. 6 27-06-1996 85 27-06-2016 380 13 E
A 21997 DE KPENV 96917614. 8 69637007. 7 27-06-1996 82 27-06-2016 760 13 E
A 23050 DE KPENV 96917612. 2 69635511. 6 27-06-1996 82 27-06-2016 760 13 E



Ik heb de macro, invoer excel en outvoer excle sheet ook als bijlage toegevoegd.

gr.
 

Bijlagen

  • macro1.txt
    3,5 KB · Weergaven: 20
  • Book1.xlsx
    10,2 KB · Weergaven: 33
Het is precies zoals je dacht:

in array is de eerste positie het startpunt voor het fixed width inlezen van de textfile. Het eindpunt wordt bepaald door het beginpunt van de volgende kolom, dus de waarde van de eerste positie in de volgende array.

de tweede positie is het datatype:
1 algemeen formaat
2 textformaat
3 datum in mdy formaat
4 datum in dmy formaat
5 datum in ymd formaat
6 datum in myd formaat
7 datum in dym formaat
8 datum in ydm formaat
9 overspringen veld (wordt niet geimporteerd)
10 datum in emd formaat

groeten
 
Code:
Option Explicit

Sub Auto_open()
'
' Macro for creating excel sheet
'
Call Reformat("c:\flop\JUN.CIP", "c:\flop\jun_new.xls")
'Application.Quit
End Sub


Sub Reformat(InputFileName As String, OutputFileName As String)
'
' Procedure for reformatting excel sheet.
'
Dim nRow As Integer
Dim Dummy As Integer

On Error GoTo err_opening_file
Workbooks.OpenText FileName:=InputFileName, Origin:= _
xlWindows, StartRow:=1, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(7, 2), _
Array(8, 2), Array(10, 2), _
Array(10, 2), Array(15, 9), _
Array(30, 2), Array(39, 2), _
Array(45, 2), Array(55, 2), _
Array(61, 5), Array(67, 2), _
Array(69, 5), Array(75, 1), _
Array(75, 1), Array(82, 1), _
Array(84, 9), Array(86, 2))
' On Error GoTo 0
' Convert strings to doubles in column G (Amount).
' This also changes the '.' sign in a value to the
' currently active decimal seperator.
nRow = 1
While (Cells(nRow, 1).Value <> "")
Cells(nRow, 8).Value = Val(Cells(nRow, 8).Value)
nRow = nRow + 1
Wend


' Reorder the collumns

Columns("K:K").Cut
Columns("M:M").Select
ActiveSheet.Paste

Columns("J:J").Cut
Columns("L:L").Select
ActiveSheet.Paste

Columns("H:H").Cut
Columns("J:J").Select
ActiveSheet.Paste

Columns("I:I").Cut
Columns("K:K").Select
ActiveSheet.Paste


' Enter formula to caculate due date into column H.
nRow = 1
While (Cells(nRow, 7).Value <> "")
Cells(nRow, 8).Formula = "=DATE(YEAR(R[0]C[-1])+R[0]C[+4]-1,MONTH(R[0]C[-1]),DAY(R[0]C[-1]))"
nRow = nRow + 1
Wend

' Enter formula to calculate next date into column G.
nRow = 1
While (Cells(nRow, 7).Value <> "")
Cells(nRow, 9).Formula = "=DATE(YEAR(R[0]C[-2])+R[0]C[+3],MONTH(R[0]C[-2]),DAY(R[0]C[-2]))"
nRow = nRow + 1
Wend


' Set the correct format for the collumns
Columns("G:G").EntireColumn.NumberFormat = "dd/mm/yyyy"
Columns("J:J").EntireColumn.NumberFormat = "dd/mm/yyyy"
Columns("H:H").EntireColumn.NumberFormat = "dd/mm/yyyy"
Columns("I:I").EntireColumn.NumberFormat = "dd/mm/yyyy"
Columns("K").NumberFormat = "#,##0.00"

' Insert header
Rows("1:1").Insert Shift:=xlDown
Range("A1").FormulaR1C1 = "A"
Range("B1").FormulaR1C1 = "B"
Range("C1").FormulaR1C1 = "C"
Range("D1").FormulaR1C1 = "D"
Range("E1").FormulaR1C1 = "E"
Range("F1").FormulaR1C1 = "F"
Range("G1").FormulaR1C1 = "Start Date"
Range("H1").FormulaR1C1 = "Due Date"
Range("I1").FormulaR1C1 = "Next Date"
Range("J1").FormulaR1C1 = "End Date"
Range("K1").FormulaR1C1 = "EUR"
Range("L1").FormulaR1C1 = "L"
Range("M1").FormulaR1C1 = "Type"


' Set font in header to bold

Range("A1:M1").Font.Bold = True


' Underline the header

With Range("A1:M1").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

' make all columns look neatly, straight and clean

Columns("A:N").EntireColumn.AutoFit
Range("A1").Select


' save this excel-sheet to the desktop

ActiveWorkbook.SaveAs FileName:=OutputFileName
ActiveWorkbook.Close

Exit Sub

err_opening_file:
On Error GoTo 0
Dummy = MsgBox("File with name '" + InputFileName + "' could not be opened.", vbOKOnly)
forced_end:
End Sub
 
@Salsero2


Duidelijk.

Maar als ik nu een kolom niet in mijn uitvoer wil, hoe krijg ik die dan weg ?

Voorbeeld:

Kolom 1 loopt van positie 0 en is 7 posities lang
Kolom 2 loopt van positie 8 en is 1 positie lang
Kolom 3 loopt van positie 9 en is 2 posities lang
Kolom 4 loopt van positie 10 en is 12 posities lang
Kolom 5 loopt van positie 21 en is 5 posities lang

Dat zou er dan zo uit moeten zien:

Code:
Array  (Array(0, 2), Array(7, 2), _
           Array(8, 2), Array(9, 2), _
           Array(10, 2), Array(21, 9)
          )


Stel nu dat ik kolom 3 niet op mijn uitvoer sheet wil hebben.

Hoe wordt de code dan ?
Als ik Array(9, 2) eruit haal, dan lijkt het alsof kolom 2 niet 1, maar 3 posities lang is ?
 
Iets wat je ook kan doen in afwachting van een andere oplossing, is alles importeren en dan Columns("C").Delete doen.
 
volgens mij heb ik de oplossing gemist.

als ik alle invoervelden definieer, en de velden die ik niet wil, type 9 van maken.

dat ga ik proberen.

het resultaat laat ik wel weten.
 
het werkt !

als je het veld type 9 maakt verschijnt het niet op de sheet.

Iedereen bedankt in het bijzonder salsero2.

Gr.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan