Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1572to1576
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Fehlerbehebung Makro

Fehlerbehebung Makro
03.08.2017 11:38:12
tito
Moin Moin,
der Nutzer franz aka fcs hat mir ein sehr schönes Makro gebaut. Leider ist mein Beitrag bezüglich des Makros ausgelaufen. Das Makro wird zum importieren bzw. formatieren von csv-Datein genutzt. Es geht dabei um Stundenabrechnungen die in Kalenderwochen aufgeteilt werden und unter den jeweils eine Summe gebildet wird(Vom Makro automatisch generiert). Leider wird rechts neben der letzten Spalte immer wieder eine weitere Summe gebildet. Wie kann ich diesen Fehler beheben.
Hier ist die Vorlage in die die CSV-Datei reinimportiert wird: https://www.herber.de/bbs/user/114950.xlsx
Hier ist eine Beispielhafte CSV-Datei: https://www.herber.de/bbs/user/114956.zip
Und hier der Code vom Makro:
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 = 40 'Projekt: Aufgabe
.Range(.Columns(3), .Columns(lngSpalte_L)).ColumnWidth = 9 'KW-Spalten
.Range(.Columns(lngSpalte_L), .Columns(lngSpalte_L)).ColumnWidth = 20 'Gesamt-Spalte
'hier wiedder einfügen
'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
'Weitere Formatierungen
'Datenbereich
With .Range(.Cells(lngZei_1, 1), .Cells(lngZei_L, lngSpalte_L))
.VerticalAlignment = xlCenter
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
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 0 And iKW datKW = fncKW_to_Datum(Jahr:=iJahr, KW:=iKW)
If KW_L 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 With
End With
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fehlerbehebung Makro
03.08.2017 23:01:22
Bastian
Hey
Ich glaube so gehts
Du musst deine letzte Spalte anders finden.
Versuch es mal so.
lngSpalte_L = .Range("A7").End(xlToRight).Column 'letzte Spalte
Bei usedrange findet er auch formatiere Zellen. Deshalb ist bei dir die Letzte Spalte 8 aber du wolltest ja nur bis 5 ?
Gruß Basti

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige