Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1756to1760
1756to1760
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro um CSV einzulsen

Forumthread: Makro um CSV einzulsen

Makro um CSV einzulsen
11.05.2020 11:44:06
Sven
Hallo zusammen,
ich bräuchte für folgendes Problem Hilfe.
ich habe ein vorhandenes Makro was XLS Datein einlesen kann und an bestimmte stelle Kopiert nun würde ich mit dem selben Makro aber auch gerne CSV einlesen.
Hat jemand eine Idee wie ich dies abändern muss ? Da meine CSV datein die Werte durch Komma getrennt sind müsste dies im Makro ja auch mit eingebaut sein das die Komma trennung aufgehoben wird.
Würde mich freuen wenn mir jemand Helfen könnte.
Liebe Grüße Sven

Sub Fileread_and_copy()
uitwerkingnaam = (Application.ActiveWorkbook.Name)
anotherfile = vbYes
Do Until anotherfile = vbNo
ritnr = InputBox("Enter run number you want to import", ritnr)
Filename = Application.GetOpenFilename("XLS files (*.xls), *.xls")
If Filename = "" Then
teller = 0
Do Until teller = 2
teller2 = teller + 1
MsgBox "you must select an xls file"
Filename = Application.GetOpenFilename("XLS files (*.xls), *.xls")
Loop
Else
Workbooks.Open Filename:=Filename
End If
If sheetname = "" Then
Sheetname_define
End If
Application.DisplayAlerts = False
Worksheets(sheetname).Range("A1:F55").Copy
bandnaam = (Application.ActiveWorkbook.Name)
Windows(bandnaam).Close
Windows(uitwerkingnaam).Activate
If ritnr = 1 Then
ActiveSheet.Paste Destination:=Worksheets("datasheet").Range("B10")
Worksheets("datasheet").Activate
Worksheets("datasheet").Range("A10").Select
Selection.Formula = bandnaam
End If
If ritnr = 2 Then
ActiveSheet.Paste Destination:=Worksheets("datasheet").Range("B70")
Worksheets("datasheet").Activate
Worksheets("datasheet").Range("A70").Select
Selection.Formula = bandnaam
End If
If ritnr = 3 Then
ActiveSheet.Paste Destination:=Worksheets("datasheet").Range("B130")
Worksheets("datasheet").Activate
Worksheets("datasheet").Range("A130").Select
Selection.Formula = bandnaam
End If
If ritnr = 4 Then
ActiveSheet.Paste Destination:=Worksheets("datasheet").Range("B190")
Worksheets("datasheet").Activate
Worksheets("datasheet").Range("A190").Select
Selection.Formula = bandnaam
End If
If ritnr = 5 Then
ActiveSheet.Paste Destination:=Worksheets("datasheet").Range("B250")
Worksheets("datasheet").Activate
Worksheets("datasheet").Range("A250").Select
Selection.Formula = bandnaam
End If
If ritnr = 6 Then
ActiveSheet.Paste Destination:=Worksheets("datasheet").Range("B310")
Worksheets("datasheet").Activate
Worksheets("datasheet").Range("A310").Select
Selection.Formula = bandnaam
End If
If ritnr = 7 Then
ActiveSheet.Paste Destination:=Worksheets("datasheet").Range("B370")
Worksheets("datasheet").Activate
Worksheets("datasheet").Range("A370").Select
Selection.Formula = bandnaam
End If
If ritnr = 8 Then
ActiveSheet.Paste Destination:=Worksheets("datasheet").Range("B430")
Worksheets("datasheet").Activate
Worksheets("datasheet").Range("A430").Select
Selection.Formula = bandnaam
End If
If ritnr = 9 Then
ActiveSheet.Paste Destination:=Worksheets("datasheet").Range("B490")
Worksheets("datasheet").Activate
Worksheets("datasheet").Range("A490").Select
Selection.Formula = bandnaam
End If
If ritnr = 10 Then
ActiveSheet.Paste Destination:=Worksheets("datasheet").Range("B550")
Worksheets("datasheet").Activate
Worksheets("datasheet").Range("A550").Select
Selection.Formula = bandnaam
End If
If ritnr = 11 Then
ActiveSheet.Paste Destination:=Worksheets("datasheet").Range("B610")
Worksheets("datasheet").Activate
Worksheets("datasheet").Range("A610").Select
Selection.Formula = bandnaam
End If
If ritnr = 12 Then
ActiveSheet.Paste Destination:=Worksheets("datasheet").Range("B670")
Worksheets("datasheet").Activate
Worksheets("datasheet").Range("A670").Select
Selection.Formula = bandnaam
End If
If ritnr = 13 Then
ActiveSheet.Paste Destination:=Worksheets("datasheet").Range("B730")
Worksheets("datasheet").Activate
Worksheets("datasheet").Range("A730").Select
Selection.Formula = bandnaam
End If
Worksheets("read in data").Activate
Worksheets("read in data").Range("B18").Select
anotherfile = MsgBox("Do you want to import another file?", vbYesNo)
Loop
End Sub

Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro um CSV einzulsen
11.05.2020 14:17:33
volti
Hallo Sven,
ohne Datei zum Testen wird Dir dabei wahrscheinlich niemand einen entsprechenden Tipp geben.
Zumal der Code, sorry, nicht besonders optimal ist. Sieht mir aus, wie eine Version aus holländischer Hand.
Falls Du Dich von dieser Version lösen kannst, findest Du nachfolgend einen alternativen Ansatz, basierend auf der Ausschnittskopie von "$A$1:$F$55". Falls die komplette CSV-Datei eingelesen werden soll, kann noch was zeitlich optimiert werden.
Wegen der wenigen Daten habe ich mich für eine Ausgabe via Schleife entschieden.
Code in die Zwischenablage
Option Explicit
Sub Fileread()
 Const csHeadText = "CSV-Datenimport"
 Dim sArr() As String, sZArr() As String, sFilename As String, sQBer As String
 Dim sData() As String, iEinfNr As String
 Dim iAnotherfile As Integer, iZeile As Long, iSpalte As Integer
 Dim ZWSh As Worksheet, oRette As Range
 Application.ScreenUpdating = False
 Set ZWSh = ThisWorkbook.Worksheets("datasheet") 'Zielblatt festlegen
 Set oRette = ActiveCell
 Do
  iEinfNr = InputBox("Bitte gib Deine Zielnummer für den Import ein!", csHeadText)
  If StrPtr(iEinfNr) = 0 Then Exit Sub
  If Val(iEinfNr) = 0 Then Exit Sub
Nochmal:
  sFilename = Application.GetOpenFileName("csv files (*.csv), *.csv")
  If sFilename = "" Then
     MsgBox "Du musst eine CSV-Datei auswählen!", vbExclamation, csHeadText
     GoTo Nochmal
  End If
'Daten in Zeile-Array einlesen
  sData = Split(CreateObject("Scripting.FileSystemObject") _
          .OpenTextFile(sFilename).ReadAll, vbCrLf)
'Ziele festlegen
  sZArr = Split(",B10,B70,B130,B190,B250,B310,B370,B430,B490,B550,B610,B670,B730,,,", ",")
'Daten übernehmen
  With ZWSh.Range(sZArr(Val(iEinfNr)))
   For iZeile = 0 To UBound(sData)
     If iZeile > 54 Then Exit For               'Maximale Zeilenanzahl
     sArr = Split(sData(iZeile), ";")
     For iSpalte = 0 To UBound(sArr)
     If iSpalte > 5 Then Exit For               'Maximale Spaltenanzahl
        .Offset(iZeile, iSpalte).value = sArr(iSpalte)
     Next iSpalte
   Next iZeile
  End With
'Dateinamen schreiben
  sArr = Split(sFilename, "\")
  ZWSh.Range(sZArr(Val(iEinfNr))).Offset(0, -1).value = sArr(UBound(sArr))
  Application.ScreenUpdating = True
  If MsgBox("Möchtest Du noch eine Datei importieren?", vbYesNo, csHeadText) = vbNo Then Exit Do
 Loop
 If Not oRette Is Nothing Then oRette.Select
End Sub
viele Grüße
Karl-Heinz

Anzeige
AW: Makro um CSV einzulsen
11.05.2020 14:45:00
Sven
Hallo Karl-Heinz,
dein Makro funktioniert Perfekt vielen vielen dank hierfür. Das einzigste was noch nicht funktioniert er schreibt mir alle Werte in eine Spalte siehe File Upload.

Ja das Makro stammt aus Holländischer Hand und ist ursprünglich auch nicht von mir da ich leider noch Änfänger in diesem Bereich bin.
Anzeige
AW: Makro um CSV einzulsen
11.05.2020 14:55:55
volti
Hallo Sven,
wie ist der Trenner in Deiner CSV-Datei?
deutsch => ; oder englisch => ,
Passe hier mal Deinen Trenner an:
sArr = Split(sData(iZeile), ";")

viele Grüße
Karl-Heinz
Anzeige
AW: Makro um CSV einzulsen
11.05.2020 14:59:48
volti
Und falls es noch Probleme mit dem Punkt geben sollte, der ja in deutsch ein Komma sein muss, könntest Du diese Änderung auch noch durchführen:
.Offset(iZeile, iSpalte).value = Replace(sArr(iSpalte),".",",")
VG KH
AW: Makro um CSV einzulsen
11.05.2020 15:21:18
Sven
Hallo Karl-Heinz,
nun funktioniert alles :)
habe , durch . ersetz und der Trenner war auch Englisch.
Funktioniert nun wunderbar.
Wünsche dir noch einen Schönen Abend und vielen Dank für deine Hilfe.
Liebe Grüße Sven
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige