noen her som kan VB?

[Bizminizer]

Jeg sliter med en kunde som er litt kravstore med tanke på et rapportformat. De MÅ ha filen i .txt, filen MÅ være fixed width, og den MÅ atpåtil ha fillers som er 0 hvis datafeltet er numerisk, og spaces hvis datafeltet er tekst..

Jeg har så langt kommet meg frem til at dette kan løses med en makro i excel, og har fått puttet inn en som gjør jobben med å gjøre om excel-rapporten til fixed width .txt med riktig antall fillers osv. Problemet er å få den til å skiller mellom der det skal være spaces og der det skal være 0 som fillers. Jeg kan tenke meg dette løses med en if-kommando, men hvilken og hvor?

Legger ved koden:

Sub Export_Selection_As_Fixed_Length_File()
     ' Dimension all  variables.
    Dim DestinationFile, CellValue, Filler_Char_To_Replace_Blanks As String
    Dim FileNum, ColumnCount, RowCount, FieldWidth As Integer
    Dim sht As Worksheet
    
    'Below are options incase you want to change the folder where VBA stores the .txt file
    'We use ActiveWorkbook.Path in this example
    'ActiveWorkbook.Path 'the activeworkbook
    'ThisWorkbook.Path  'the workbook with the code
    'CurDir  'the current directory (when you hit File|open)


    'If a cell is blank, what character should be used instead
    Filler_Char_To_Replace_Blanks = ""
     
        'Check if the user has made any selection at all
        If Selection.Cells.Count < 2 Then
            MsgBox "Nothing selected to export"
            Selection.Activate
            End
        End If
     
    'This is the destination file name.
    DestinationFile = ActiveWorkbook.Path & "/File_With_Fixed_Length_Fields.txt"
    'Obtain next free file handle number.
    FileNum = FreeFile()
    
     ' Turn  error checking off.
    On Error Resume Next
     
     ' Attempt to open destination file for output.
    Open DestinationFile For Output As #FileNum
     
     ' If an error occurs report it and end.
    If Err <> 0 Then
         MsgBox "Cannot open filename " & DestinationFile
         Selection.Activate
        End
    End If
     
     ' Turn error checking on.
    On Error GoTo 0
     
     '  Loop for each row in selection.
    For RowCount = 1 To Selection.Rows.Count
                For ColumnCount = 1 To Selection.Columns.Count
                    CellValue = Selection.Cells(RowCount, ColumnCount).Text
                    If (IsNull(CellValue) Or CellValue = "") Then CellValue = Filler_Char_To_Replace_Blanks
                    FieldWidth = Cells(1, ColumnCount).Value
                    If (ColumnCount = Selection.Columns.Count) Then
                            Print #FileNum, Format$(CellValue, "!" & String(FieldWidth, "@")) & vbCrLf;
                    Else: Print #FileNum, Format$(CellValue, "!" & String(FieldWidth, "@"));
                    End If
                Next ColumnCount
         ' Start next iteration of RowCount loop.
    Next RowCount
     ' Close destination file.
    Close #FileNum
    Selection.Activate
    Workbooks.OpenText Filename:=DestinationFile
End Sub

 

[Nutz]

Du kan finne ut hvilken celletype det er med "NumberFormat" for å avgjøre hvilken type padding du skal benytte..
If Sheet1.Cells(RowCount, ColumnCount).NumberFormat ="@" then ...

 

[Bizminizer]

Takker, det høres riktig ut men jeg kan alt for lite VB til å kunne kode det inn selv. Løste det ved å legge inn hjelpekolonner som er fylt med det antall 0 som trengtes der paddingen ikke skulle være de standard mellomrommene.