Tabs nicht einheitlich | Herbers Excel-Forum

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Informationen und Beispiele zum Thema MsgBox
Screenshot zu MsgBox	MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Tabs nicht einheitlich | Herbers Excel-Forum

Tabs nicht einheitlich von Michael vom 28.01.2010 08:41:03

AW: Tabs nicht einheitlich - von MichaV am 28.01.2010 09:07:13
- AW: Tabs nicht einheitlich - von Michael am 28.01.2010 09:12:35
  - ist es .. Tabs nicht einheitlich - von Mike am 28.01.2010 09:26:26
    - AW: ist es .. Tabs nicht einheitlich - von Michael am 28.01.2010 09:31:27
  - AW: Tabs nicht einheitlich - von MichaV am 28.01.2010 10:27:17
    - mit Verbesserung - von MichaV am 28.01.2010 13:35:11
      - AW: mit Verbesserung - von Michael am 28.01.2010 14:11:41
        
        Danke für die Rückmeldung - von MichaV am 28.01.2010 14:23:10
kleine Anmerkung .. Tabs nicht einheitlich - von Mike am 28.01.2010 09:12:06
- AW: kleine Anmerkung .. Tabs nicht einheitlich - von Michael am 28.01.2010 09:13:40

Betrifft: Tabs nicht einheitlich von: Michael
Geschrieben am: 28.01.2010 08:41:03

Guten morgen,
hab folgendes Problem: Mein Code wandelt eine Excel-Datei in ein txt-Format um und macht beim abspeichern noch zusätzlich einen Namensvorschlag. Das Problem liegt darin, dass in der txt-Datei die einzelnen Spalten nicht direkt unter einander sind, man kann aus der txt. datei halt nich heraus lesen was zu welcher Überschrift gehört. Das sieht dann so aus:

Der Code in VBA sieht so aus:



Sub test()
Dim Dein_Bereich As Range
Dim sZiel As String, Ausgabe As String
Dim F As Integer

Const strTrennzeichen As String = vbTab

Set Dein_Bereich = Sheets("upload_Kanal").Range("A3:L10")
Dateiname = Sheets("Tabelle1").Cells(5, 1)
sZiel = Application.GetSaveAsFilename(Initialfilename:=Dateiname, filefilter:="(*.xls), *.xls,   _
 _
 _
 _
 _
_
Text Files (*.txt), *.txt")

If sZiel <> CStr(False) Then
  
  With Application
    For Each Dein_Bereich In Dein_Bereich.Rows
     If .WorksheetFunction.CountIf(Dein_Bereich, vbTab) < Dein_Bereich.Columns.Count Then
      Ausgabe = Ausgabe & Join(.Transpose(.Transpose(Dein_Bereich)), strTrennzeichen) & vbCrLf
     End If
    Next Dein_Bereich
  End With
  
  If Ausgabe <> vbTab Then
    Ausgabe = Left$(Ausgabe, Len(Ausgabe) - 1)
     
    F = FreeFile
    Open sZiel For Output As #F
    Print #F, Ausgabe
    Close #F
  Else
    MsgBox "keine Daten vorhanden"
End If
End If
End Sub

Ich bin über jede Hilfe dankbar, der Sinn des ganzen ist es die txt-Datei später wieder in ein Programm einzulesen, das leider keine xls-dateien einlesen kann.
Vielen dank im voraus, schon einmal =)

Gruß Michael

Betrifft: AW: Tabs nicht einheitlich von: MichaV
Geschrieben am: 28.01.2010 09:07:13

Hallo,

hast Du den Code selbst geschrieben und willst die Lösung selber entwickeln? Dann schau Dir mal die Tab()- Funktion in VBA an. Ansonsten lade mal eine Bsp-Tabelle hoch und Du kriegst ne Lösung.

Gruss- Micha

Betrifft: AW: Tabs nicht einheitlich von: Michael
Geschrieben am: 28.01.2010 09:12:35

Hallo,
ja hab den code selbst geschrieben. Ich bekomm des aber leider nicht hin.
Hier mal die Beispiel-Tabelle.

https://www.herber.de/bbs/user/67573.xls

Gruß
Michael

Betrifft: ist es .. Tabs nicht einheitlich von: Mike
Geschrieben am: 28.01.2010 09:26:26

Hey Michael,

ist es denn überhaupt sinnvoll, dass man die Spaltenzuteilungen
in der TXT sieht? Die Logik als solches ist ja sichtbar.

Hauptsache das andere Programm kommt mit dem Input klar.

Gruss
Mike

Betrifft: AW: ist es .. Tabs nicht einheitlich von: Michael
Geschrieben am: 28.01.2010 09:31:27

Hey Mike,

ja es sollte schon erkennbar sein, auch in der txt-Datei.
Weißt du da ne Lösung?

Gruß Michael

Betrifft: AW: Tabs nicht einheitlich von: MichaV
Geschrieben am: 28.01.2010 10:27:17

Hallo,

versuch das mal:

Option Explicit

Sub test()

    Dim i As Long, k As Long, x As Long, y As Long, Trennzeichen, Dateiname As String
    Dim sZiel As String
    Dim F As Integer
    
    Trennzeichen = Array(0, 20, 40, 60, 70, 80, 90, 100) '<-- hier fixe Spaltenbreiten  _
definieren
    
    Dateiname = Sheets("upload_Kanal").Cells(5, 1)
    sZiel = Application.GetSaveAsFilename(InitialFileName:=Dateiname, filefilter:="(*.txt), *. _
txt, Text Files (*.txt), *.txt")
    
    If sZiel <> CStr(False) Then
      
    y = Sheets("upload_Kanal").Range("A3").End(xlDown).Row 'musst Du ggf. an Deine Bedürfnisse  _
anpassen, ich gehe hier davon
                                                           'aus dass rechts und unter Deiner  _
Tabelle eine Leerspalte/Zeile ist
    x = Sheets("upload_Kanal").Range("a3").End(xlToRight).Column
    F = FreeFile
    Open sZiel For Output As #F
    For i = 3 To y
        For k = 1 To x
        Print #F, Sheets("upload_Kanal").Cells(i, k);       'hier wird der Wert geschrieben
        If k < x Then Print #F, Tab(Trennzeichen(k)); "|";  'hier wird der Ausgabecursor auf  _
die nächste Spalte gestellt
    Next k
    If i < y Then Print #F, "" 'hier eine neue Zeile (weil Print nicht mit ; abgeschlossen)
    
    Next i
    
    Close #F

    End If
End Sub

Betrifft: mit Verbesserung von: MichaV
Geschrieben am: 28.01.2010 13:35:11

Hallo nochmal,

hier eine Variante mit automatischer Ermittlung der notwendigen Spaltenbreite.

Option Explicit

Sub test()

    Dim i As Long, k As Long, x As Long, y As Long, b As Integer, s() As Integer, Dateiname As  _
String
    Dim sZiel As String
    Dim F As Integer
    
    'Trennzeichen = Array(0, 20, 40, 60, 70, 80, 90, 100) '<-- hier fixe Spaltenbreiten  _
definieren
    
    Dateiname = Sheets("upload_Kanal").Cells(5, 1)
    sZiel = Application.GetSaveAsFilename(InitialFileName:=Dateiname, filefilter:="(*.txt), *. _
txt, Text Files (*.txt), *.txt")
    
    If sZiel <> CStr(False) Then
      
    y = Sheets("upload_Kanal").Range("A3").End(xlDown).Row 'musst Du ggf. an Deine Bedürfnisse  _
anpassen, ich gehe hier davon
                                                           'aus dass rechts und unter Deiner  _
Tabelle eine Leerspalte/Zeile ist
    x = Sheets("upload_Kanal").Range("a3").End(xlToRight).Column
    
    'erforderliche Spaltenbreite für jede Spalte ermitteln
    ReDim s(x)
    For k = 1 To x
        For i = 3 To y
            If Len(Cells(i, k)) > s(k) Then s(k) = Len(Cells(i, k))
        Next i
    Next k
    
    F = FreeFile
    Open sZiel For Output As #F
    For i = 3 To y
        For k = 1 To x
            b = b + s(k) + 1
            Print #F, CStr(Sheets("upload_Kanal").Cells(i, k));       'hier wird der Wert  _
geschreiben
            If k < x Then Print #F, Tab(b); "|";       'hier wird der Ausgabecorsor auf die nä _
chste Spalte gestellt
            
        Next k
        If i < y Then Print #F, "" 'hier eine neue Zeile (weil Print nicht mit ; abgeschlossen)
        b = 0
    Next i
    
    Close #F

    End If
End Sub

Eine Rückmeldung wäre übrigens super, gerade weils ja so dringend war...

Gruss- Micha

Betrifft: AW: mit Verbesserung von: Michael
Geschrieben am: 28.01.2010 14:11:41

Hey,
sorry für die späte Mitteilung.
Ist wirklich alles super, hatte vorher die Präsentation.
Funktioniert einwandfrei.
Hast mir wirklich den Allerwertesten gerettet =)
Danke nochmals.
Gruß Michael

Betrifft: Danke für die Rückmeldung von: MichaV
Geschrieben am: 28.01.2010 14:23:10

..na da freu ich mich für Dich.

Gruss aus Norwegen.

Betrifft: kleine Anmerkung .. Tabs nicht einheitlich von: Mike
Geschrieben am: 28.01.2010 09:12:06

Hey Michael,

kleine Anmerkung am Rande: zum gleichen Thema brauchts nicht zwei Beiträge .. ;-)
https://www.herber.de/forum/messages/1133514.html

Gruss
Mike

Betrifft: AW: kleine Anmerkung .. Tabs nicht einheitlich von: Michael
Geschrieben am: 28.01.2010 09:13:40

Sorry, ja ich weiß, brauch halt dringend ne Lösung,
muss des heute Mittag präsentieren. Sonst würde ich
des natürlich nicht machen.
Gruß Michael

Herbers Excel/VBA-Archiv

Der kurze Weg zum Ziel: Auftragsprogrammierung

Tabs nicht einheitlich | Herbers Excel-Forum