AW: Datenimport mit skalierter Tabelle
28.07.2017 20:57:35
fcs
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)