Microsoft Excel

Herbers Excel/VBA-Archiv

Datenimport mit skalierter Tabelle


Betrifft: Datenimport mit skalierter Tabelle von: tito
Geschrieben am: 27.07.2017 10:11:48

Moin alle zusammen,

Ich habe diese Vorlage https://www.herber.de/bbs/user/114950.xlsx und unterhalb der von mir erstellten Felder (Name, Projektname, Email, Zeitraum etc.) möchte ich eine Tabelle einfügen. Diese Tabelle soll aus einer CSV-Datei erstellt werden, z.B. dieser hier: https://www.herber.de/bbs/user/114956.zip Wenn ich diese CSV Datei über Excell importiere erstellt er mir auch eine Tabellle in dem von mir gewünschten Bereich, jedoch skaliert die Tabelle nicht auf die volle Seitenbreite (A4 quer). Ich habe bereits versucht das Problem über Seitenlayout - An Format Anpassen - Breite - 1 Seite zu lösen, ohne Erfolg. Was kann ich nun tun, um die Tabelle automatisch auf die volle Breite skalieren zu lassen ? Die angefügte CSV-Datei stellt nur ein Beispiel dar, es könnten bspw. auch 5 oder 6 Spalten vorhanden sein. In solch einem Fall sollte die Tabelle sich ebenfalls an die Seitenbreite anpassen. Ich habe bereits versucht das Problem über ein Makro zu lösen, dabei habe ich diesen Code verwendet:

With ActiveSheet.PageSetup
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = False
End With

Hat leider nicht den gewünschten Effekt erzielt.

Viele Grüße

  

Betrifft: AW: Datenimport mit skalierter Tabelle von: tito
Geschrieben am: 28.07.2017 10:41:59

Hat niemand eine Idee ? Oder habe ich das Problem nicht verständlich erklärt ? Ich bin über jeden Tipp dankbar :)


  

Betrifft: AW: Datenimport mit skalierter Tabelle von: fcs
Geschrieben am: 28.07.2017 11:17:41

Hallo Tito,

die Skalierung wirkt sich erst aus, wenn bei 100% Darstellung im Druck der Blatt-Inhalt nicht mehr auf eine Seite passt.
In deinem Beispiel erst, wenn mindestens 12 Spalten mit Werten für Wochen importiert werden.

Bei mir sah das Bild aber etwas unschön aus, da bei einer KW immer ein Zeilen-Umbruck in der Zelle erzeugt wurde.
Ich würde hier die Spaltenbreiten im Nachlauf formatieren.

Gruß
Franz

Sub aaaaImport_Stunden_Daten()
'
' Import_Stunden_Daten Makro
' Stundendaten aus CSV-Dateiimportieren via Daten-Import
'
    Dim varCSV_Datei As Variant
    Dim wks As Worksheet
    Dim lngSpalte_L As Long
    
    Set wks = ActiveSheet
'
    varCSV_Datei = "C:\Users\Public\NeuTest\stunden_nach_MA_und_aufgabe.csv"
    
    varCSV_Datei = Application.GetOpenFilename(Filefilter:="CSV-Dateien (*.csv),*.csv)", _
        Title:="Bitte zu importierende CSV-Datei auswählen")
        
    If varCSV_Datei = False Then Exit Sub
    
    With wks.QueryTables.Add(Connection:="TEXT;" & varCSV_Datei, _
        Destination:=wks.Range("$A$6"))         'Einfüge-Zelle ggf. anpassen
        .Name = "stunden_nach_MA_und_aufgabe"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001  'UTF-8 hier ggf. Anpassen wenn Umlaute
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    'Spaltenbreiten nachformatierungen
    With wks
        lngSpalte_L = .UsedRange.Column + .UsedRange.Columns.Count - 1
        .Columns("A:A").ColumnWidth = 15 'MA-Name
        .Columns("B:B").ColumnWidth = 28 'oder .Autofit
        .Range(.Columns(3), .Columns(lngSpalte_L)).ColumnWidth = 20 'Überbreite einstellen
        .Range(.Columns(3), .Columns(lngSpalte_L)).AutoFit
        
        'erzeugte Datenverbindungen aus  dem Import wieder löschen
        On Error Resume Next
        .QueryTables(1).Delete
        ActiveWorkbook.Connections(1).Delete
    End With
End Sub



  

Betrifft: AW: Datenimport mit skalierter Tabelle von: tito
Geschrieben am: 28.07.2017 13:48:07

Super, vielen vielen Dank :) Das sieht schon mal um einiges besser aus. Habe an dem Code noch ein paar Einstellungen vorgenommen und jetzt sieht es ganz gut aus. Der Zeilenumbruch stört mich auch etwas. Wär es möglich nach einer bestimmten Anzahl von Zeichen einen Umnbruch durchzuführen ? Zusätzlich würde ich gerne automatisch eine Summe der KW´s bzw. der Stunden bilden lassen. Gibt es da eine Möglichkeit ?


  

Betrifft: AW: Datenimport mit skalierter Tabelle von: fcs
Geschrieben am: 28.07.2017 20:57:35

Hallo Tito,

sowohl den Umbruch kann man realisieren, als auch die Summenformeln einfügen.

Ich hab im Makro jetzt programmiert, dass die KW nach der Jahreszahl und die Aufgabe nach dem Doppelpunkt (6. Zeichen) umgebrochen wird.
Die Summenformel wird 2 Zeilen unterhalb der letzten importierten Zeile eingefügt.

Für den Umbruch hab ich eine kleine Function erstellt, die für die relevanten Zellbereiche aufgerufen wird.

Damit es am Ende sauber aussieht muss man auch an den Formatierungen etwas mehr machen.

Gruß
Franz

Sub aaaaImport_Stunden_Daten()
'
' Import_Stunden_Daten Makro
' Stundendaten aus CSV-Dateiimportieren via Daten-Import
'
    Dim varCSV_Datei As Variant
    Dim wks As Worksheet
    Dim lngSpalte_L As Long
    Dim lngZei_1 As Long, lngZei_L As Long, lngZeiSum As Long, lngSpa_1 As Long
    Dim rngZelle As Range
    
    Set wks = ActiveSheet
    lngZei_1 = 7          'Zeile ab der Import eingefügt werden soll (Spaltentitel)
    lngSpa_1 = 1          '1. Spalte ab der Import eingefügt werden soll
    

    varCSV_Datei = "C:\Users\Public\NeuTest\stunden_nach_MA_und_aufgabe.csv"
    
    varCSV_Datei = Application.GetOpenFilename(Filefilter:="CSV-Dateien (*.csv),*.csv)", _
        Title:="Bitte zu importierende CSV-Datei auswählen")
        
    If varCSV_Datei = False Then Exit Sub
    
    Application.ScreenUpdating = False
    
    'Basis-Formatierungen einstellen für den Importbereich
    With wks
        With .Range(.Rows(lngZei_1), .Rows(.Rows.Count))
            .ClearContents
            .EntireRow.AutoFit
            .NumberFormat = "General"
            .VerticalAlignment = xlTop
            .Font.Bold = False
        End With
        'Zeilenumbruch in Spalte B (Aufgabe)
        With .Range(.Cells(lngZei_1, 2), .Cells(.Rows.Count, 2))
            .WrapText = True
        End With
    End With
    
    With wks.QueryTables.Add(Connection:="TEXT;" & varCSV_Datei, _
        Destination:=wks.Cells(lngZei_1, lngSpa_1))
        .Name = "stunden_nach_MA_und_aufgabe"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001  'UTF-8 hier ggf. Anpassen wenn Umlaute
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
    'Spaltenbreiten Nachformatierungen, Summenformel
    With wks
    'relevante Zeilen und Spalten ermitteln/setzen
        lngSpalte_L = .UsedRange.Column + .UsedRange.Columns.Count - 1 'letzte Spalte
        lngZei_L = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte Zeilemit daten
        lngZeiSum = lngZei_L + 2 'Zeile für Summen KW/gesamt
    'Spaltenbreiten
        .Columns("A:A").ColumnWidth = 18 'MA-Name
        .Columns("B:B").ColumnWidth = 28 'Projekt: Aufgabe
        .Range(.Columns(3), .Columns(lngSpalte_L)).ColumnWidth = 6 'KW-Spalten
        .Range(.Columns(lngSpalte_L), .Columns(lngSpalte_L)).AutoFit 'Gesamt-Spalte
        
    'Textumbrüche in Zellen einfügen
        '1. Umbruch zwischen Jahr und KW vor dem Bindestrich
        With .Range(.Cells(lngZei_1, 3), .Cells(lngZei_1, lngSpalte_L - 1))
            .WrapText = True
            For Each rngZelle In .Cells
                rngZelle.Value = fncUmbruch(rngZelle.Text, 4)
            Next
        End With
        
        '2. Umbruch in Aufgabe nach 6. Zeichen
        With .Range(.Cells(lngZei_1 + 1, 2), .Cells(lngZei_L, 2))
            .WrapText = True
            For Each rngZelle In .Cells
                rngZelle.Value = fncUmbruch(rngZelle.Text, 6)
            Next
        End With
        
        'Zeilenhöhen automatisch anpassen
        With .Range(.Cells(lngZei_1, 1), .Cells(lngZeiSum, 1))
            .EntireRow.AutoFit
        End With
        
        'Summenformel einfügen
        .Range(.Cells(lngZeiSum, 3), .Cells(lngZeiSum, lngSpalte_L)).FormulaR1C1 _
            = "=SUM(R" & lngZei_1 + 1 & "C:R" & lngZei_L & "C)"
        
        .Cells(lngZeiSum, 2).Value = "Summe"
        'Summenzeile Schrift = fett
        .Rows(lngZeiSum).Font.Bold = True
        
        'Zahlenwerte für Stunden formatieren
        With .Range(.Cells(lngZei_1 + 1, 3), .Cells(lngZei_l, lngSpalte_L))
            .NumberFormat = "0.0;-0.0;0.0;@"
        End With
        With .Range(.Cells(lngZeiSum, 3), .Cells(lngZeiSum, lngSpalte_L))
            .NumberFormat = "0.0;-0.0;0.0;@"
        End With
        'KW und Stunden in Zellen nach rechtem Rand ausgerichtet.
        With .Range(.Cells(lngZei_1, 3), .Cells(lngZei_L, lngSpalte_L))
            .HorizontalAlignment = xlRight
        End With
         With .Range(.Cells(lngZeiSum, 3), .Cells(lngZeiSum, lngSpalte_L))
            .HorizontalAlignment = xlRight
        End With
       
        'erzeugte Datenverbindungen aus dem Import wieder löschen
        On Error Resume Next
        .QueryTables(1).Delete
        ActiveWorkbook.Connections(1).Delete
    End With
    
    Application.ScreenUpdating = True
End Sub

Function fncUmbruch(ByVal sText As String, ByVal PosZeichen As Integer) As String
    'Bricht den Text nach der Position um durch Einfuegen einer Zeilenschaltung
    If sText = "" Or Len(sText) <= PosZeichen Then
        fncUmbruch = sText
    Else
        fncUmbruch = Left(sText, PosZeichen) & Chr(10) & Mid(sText, PosZeichen + 1)
    End If
End Function



  

Betrifft: AW: Datenimport mit skalierter Tabelle von: tito
Geschrieben am: 02.08.2017 09:58:15

Vielen Dank fcs,

sieht wirklich gut aus :) Ich werde mich jetzt mal an die Formatierung machen und mich da reinfuchsen. Was würdet ihr denn noch so empfehlen bezüglich der Formatierung ? Könnte man aus den vorhandenen Daten aus der CSV die Zeitspanne im oberen Teil der Vorlage automatisch ausfüllen lassen ?


  

Betrifft: AW: Datenimport mit skalierter Tabelle von: fcs
Geschrieben am: 03.08.2017 03:45:39

Hallo Tito,

den Datumsbereich kann man aus den Werten für Jahr und KW berechnen.

Bezüglich Formatierungen kannst du z.B. noch Rahmenlinien und vertikale Ausrichtung der Zellinhalte ergänzen.
Nachfolgende das Ende meines Makros mit den erforderlichen Anpassungen und eine Function zur Berechnung des Montags einer KW im Jahr.

Gruß
Franz

        On Error Resume Next
        .QueryTables(1).Delete
        ActiveWorkbook.Connections(1).Delete
        
        
        'Weitere Formatierungen
        'Datenbereich
        With .Range(.Cells(lngZei_1, 1), .Cells(lngZei_L, lngSpalte_L))
            .VerticalAlignment = xlCenter
            With .Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
        End With
        
        'Summenzeile
        With .Range(.Cells(lngZeiSum, 1), .Cells(lngZeiSum, lngSpalte_L))
                .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
                .VerticalAlignment = xlCenter
                .RowHeight = 22
        End With
        With .Range(.Cells(lngZeiSum, 2), .Cells(lngZeiSum, lngSpalte_L))
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
        End With
        
        '1. und letztes Datum aus KW-Werten ermitteln und als Text in Zelle A4 zusammenfügen
        Dim datKW As Date, KW_1 As Date, KW_L As Date, iJahr As Integer, iKW As Integer
        'Startwerte für Datum von 1. und letzter KW setzen
        KW_L = 0
        KW_1 = DateSerial(Year(Date) + 20, 12, 31)
        'Zellen mit Jahr-KW abarbeiten
        For Each rngZelle In .Range(.Cells(lngZei_1, 3), .Cells(lngZei_1, lngSpalte_L - 1)). _
Cells
            With rngZelle
                iJahr = Val(Left(.Text, 4))
                iKW = Val(Mid(.Text, InStrRev(.Text, "-") + 1))
            End With
            If iJahr > 1900 And iJahr <= (Year(Date) + 20) And iKW > 0 And iKW <= 53 Then
                datKW = fncKW_to_Datum(Jahr:=iJahr, KW:=iKW)
                If KW_L < datKW Then KW_L = datKW
                If KW_1 > datKW Then KW_1 = datKW
            End If
        Next
        
        .Range("A4").Value = "Zeitraum: " & Format(KW_1, "DD.MM.YYYY") & " - " _
                                          & Format(KW_L + 6, "DD.MM.YYYY")
    End With
    
    Application.ScreenUpdating = True
End Sub

Public Function fncKW_to_Datum(ByVal Jahr As Integer, ByVal KW As Integer) As Date
    'Berechnet für die KW im Jahr das Datum des Montags - Basis: ISO 8601
    Dim datMontag_KW1 As Date, Wochentag_1_Jan As Integer
    
    'Wochentag des 1. Januars im Jahr - Montag = 1
    Wochentag_1_Jan = Weekday(DateSerial(Jahr, 1, 1), vbMonday)
    
    'Montag in der Woche mit dem 1.Januar
    datMontag_KW1 = DateSerial(Jahr, 1, 1) - Wochentag_1_Jan + 1
    
    If Wochentag_1_Jan > 4 Then   'Der 1. Januar liegt in der letzten.KW des Vorjahres
        datMontag_KW1 = datMontag_KW1 + 7
    End If
    
    fncKW_to_Datum = datMontag_KW1 + (KW - 1) * 7
End Function



Beiträge aus den Excel-Beispielen zum Thema "Datenimport mit skalierter Tabelle"