Anzeige

Excel VBA - Datum wir nach Export nicht richtig deklariert


jerry0110

Erfahrenes Mitglied
#1
Hallo zusammen,

ich habe mal wieder eine Herausforderung.
Ich habe eine CSV die ich in eine Excel kopiere.
Er übernimmt auch die Daten und es klappt auch so gut wie alles.
Aber das Datum wird so übernommen, dass ich theoretisch mit F2 in die Zelle gehen und dann Enter drücken muss, damit das dann auch als Datum deklariert wird.

Code:
Sub xCopy3()

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim QWB As Workbook, ZWB As Workbook
Workbooks.Open "\\oda-san1\Auswertung_Report_JLI.xlsx"
Set QWB = Workbooks("Auswertung_Report_JLI.xlsx")
Set ZWB = Workbooks("Aktionsbericht_Neu.xls")                  ' Ziel, Workbook mit diesem Makro
Dim QWS As Worksheet, ZWS As Worksheet
Set QWS = QWB.Worksheets("Tabelle1")                                        ' Quelle
Set ZWS = ZWB.Worksheets("SQL-Ergebnisse")                                              ' Ziel

    QWS.Cells.Copy ZWS.Cells(1, 1)                                              ' Inhalt in Ziel-Tabelle einfügen
    Workbooks("Auswertung_Report_JLI.xlsx").Close
    Kill ("\\oda-san1\Auswertung_Report_JLI.xlsx")
    Kill ("\\oda-san1\Auswertung_Report_JLI.csv")
Application.EnableEvents = True
End Sub

Sub CSV()
  Dim sFile As String, sPath As String, iFree As Integer
  Dim arrCSV, arrTmp, arrXLS(), i As Long, j As Integer, n As Long
  Dim zFile As String
  Dim myDate As Date
 

  sPath = "\\oda-san1\"       'anpassen
  sFile = Dir(sPath & "*.csv")
  zFile = "Auswertung_Report_JLI"
  Application.ScreenUpdating = False
 
  Do While Len(sFile)
 
    iFree = FreeFile
    Open sPath & sFile For Input As iFree
    arrCSV = Split(Input(LOF(iFree), iFree), vbCrLf)
    Close iFree
 
    For i = 0 To UBound(arrCSV)
      arrTmp = Split(arrCSV(i), ";")
      n = Application.Max(n, UBound(arrTmp))
    Next
 
    ReDim arrXLS(1 To UBound(arrCSV) + 1, 1 To n + 1)
    For i = 0 To UBound(arrCSV)
      arrTmp = Split(arrCSV(i), ";")
      For j = 0 To UBound(arrTmp)
        arrXLS(i + 1, j + 1) = arrTmp(j)
      Next
    Next
 
    With Workbooks.Add
      .Sheets(1).Cells(1, 1).Resize(UBound(arrXLS), UBound(arrXLS, 2)) = arrXLS
      .SaveAs sPath & Mid(zFile, 1, Len(sFile) - 4)
      .Close
    End With
 
    sFile = Dir
  Loop
  xCopy3
  ThisWorkbook.Sheets("Agenturbericht").Range("H7").Value = Date
  ThisWorkbook.Sheets("SQL-Ergebnisse").Range("B:B").NumberFormat = "dd.mm.yy;@"
End Sub
 
Zuletzt bearbeitet:

Yaslaw

n/a
Moderator
#3
Du füllst ja Feld für Feld ab. Wenn du weisst, welche Spalte das Datum ist, kannst du konvertieren
Visual Basic:
For j = 0 To UBound(arrTmp)
	Select Case j
	Case 3,4,5:             	'Alle Datumspalten
		arrXLS(i + 1, j + 1) = CDate(arrTmp(j))
	Case 1,10,13:        		'Alle Zahlenspalten
		arrXLS(i + 1, j + 1) = CDbl(arrTmp(j))
	Case Else:
		arrXLS(i + 1, j + 1) = arrTmp(j)
	End Case
Next
 

jerry0110

Erfahrenes Mitglied
#4
Ich habe es jetzt auf einen Umweg versucht

Code:
Private Sub Formel()
Application.ScreenUpdating = False
Dim lastCol As Long
Dim lastRow As Long
Dim Source As Worksheet

Set Source = ThisWorkbook.Worksheets("SQL-Ergebnisse")

lastRow = xlsGetLastRow(Source)

Source.Range("M1").Value = "Bestellungen"
Source.Range("N1").Value = "Datum"

For f = lastRowNr(Source) To 1 Step -1
   
    Source.Range("M" & f).FormulaLocal = "=LÄNGE(L" & f & ")-LÄNGE(WECHSELN(L" & f & ";"","";""""))+1"
    Source.Range("N" & f).FormulaLocal = "=B" & f & "*1"
    Source.Range("N" & f).NumberFormat = "dd.mm.yyyy"
    Source.Range("O" & f).FormulaLocal = "=K" & f & "*1"
    Source.Range("O" & f).NumberFormat = "#.##0 €;-#.##0 €"

Next f
Application.ScreenUpdating = True
End Sub
Weil auch die Spalte K mit Euro versehen ist und er daraus auch kein richtiges Format macht.
 

jerry0110

Erfahrenes Mitglied
#7
Du füllst ja Feld für Feld ab. Wenn du weisst, welche Spalte das Datum ist, kannst du konvertieren
Visual Basic:
For j = 0 To UBound(arrTmp)
    Select Case j
    Case 3,4,5:                 'Alle Datumspalten
        arrXLS(i + 1, j + 1) = CDate(arrTmp(j))
    Case 1,10,13:                'Alle Zahlenspalten
        arrXLS(i + 1, j + 1) = CDbl(arrTmp(j))
    Case Else:
        arrXLS(i + 1, j + 1) = arrTmp(j)
    End Select
Next

Also nur für mein Verständnis.

mir dem Code suche ich anhand des Case die Spalte wo z. B. das Datum ist.
In meinem Fall ist es die Spalte "B". Dann ändere ich den Case auf die Nummer 2 für die 2te Spalte und er ändert dann die Zelle in ein Datumsformat.
Und die Spalte J und K wo die Beträge vorhanden sind, dann nehme ich bei Case 1,10,13 die Case 10,11
Wenn ich das so richtig verstanden habe, dann macht er das nicht.
 

jerry0110

Erfahrenes Mitglied
#9
Ich hoffe ich verstehe das jetzt richtig.
Wenn ich die CSV auf mache und mit rechts auf das Datum klicke dann steht hier das Format Datum mit dem Typ *14.03.2001
 

Yaslaw

n/a
Moderator
#10
Nein. Du öffnest diene CSV ja als Text und importierst die Feld für Feld.
CSV ist eine reine Textdatei. Da kann es verschiedene Formate haben. Aber es ist immer TEXT. Um das Format zusehen muss man die CSV Datei mit einem Texteditor (zB Notepad) öffnen. NICHT mit Excel, denn Excel wandelt bereits alles irgendwie nach Lust und Laune um.

Entweder importierst du das CSV indem du es einfach im Excel öffnest, oder indem die Text auswertest.

Andere Frage.
Due gehst Feld für Feld durch und baust dir damit einen 2dimensionalen Array. Diesen schreibst du anschliessend in die Tabelle.
Warum nicht direkt Feld für Feld in die Tabelle?
 

jerry0110

Erfahrenes Mitglied
#11
Ich habe den o. s. Code irgendwann mal von dir bekommen und habe ihn kopiert.
Auch wenn ich viel schon selber hinbekommen habe ich den o. g. code noch nie verstanden. Leider.

Code:
Nummer;Datum;Mitarbeiter;Ergebnis;Ergebnislang;kein Interesse weil;Info1;Info2;Anzahl Rezepteinbehalte;Anzahl Korrekturbelege;Preis Dienstleistung in Euro;Kundennummer
62752;14.03.2018;230SBO;X;3 x nicht Erreicht;;;;;72;3.375,08 €;62752
50158;26.03.2018;230JLA;X;3 x nicht Erreicht;;;;;98;1.793,91 €;50158
90856;26.03.2018;230SBO;X;3 x nicht Erreicht;;;;;8;118,31 €;90856
44195;14.03.2018;230SBO;X;3 x nicht Erreicht;;;;;4;179,84 €;44195
Das bekomme ich bei Notepad angezeigt
 
Anzeige

Neue Beiträge

Anzeige