Import optimieren

[MichaLauterbach]

Hallo zusammen,

Ich importieren beim Öffnen einer Datei automatisch Daten aus zwei anderen (geschlossenen) Datein, um die dann per Vlookup zu verarbeiten.
Das funktioniert auch soweit, wenn auch etwas holprig.

Kann ich das irgendwie eleganter lösen bzw das es schneller ausgeführt wird?


Private Sub Auto_open()
Workbooks.Open Filename:=" \\netzlaufwerk.com\ordner\quelle.csv", UpdateLinks:=0, Notify:=False, ReadOnly:=True
 With ActiveWorkbook
  .Sheets(1).Range("A1:I600").Copy
 End With
 With ThisWorkbook.Sheets(3)
     .Range("B1:J600").PasteSpecial
     Application.CutCopyMode = False
     .Activate
     .Cells(1, 1).Select
 End With
 Workbooks("quelle.csv").Close
End Sub


Schöne Grüße

[volti]

Hallo Micha.

wenn Du es weiterhin mit Workbook.Open machen möchtest, sollte dieses hier (ungetestet) genügen:

Code:

Private Sub Auto_open()
  Workbooks.Open Filename:="\\netzlaufwerk.com\ordner\quelle.csv", UpdateLinks:=0, Notify:=False, ReadOnly:=True
  ThisWorkbook.Sheets(3).Range("B1:J600").value = ActiveWorkbook.Sheets(1).Range("A1:I600").value
  Workbooks("quelle.csv").Close
End Sub

____________________

viele Grüße aus Freigericht
Karl-Heinz

---

Hallo Micha,

und hier noch eine Variante ohne Workbook.Open (ungetestet und ohne Fehlerabfang):

Code:

Sub Alle_Werte_aus_CSV_Datei()
'Sub liest die Werte aus einer CSV/Text-Datei ein
'Ziel ist eine beliebige Zelle auf einem Blatt
 Dim iZeile As Long
 Dim oZiel As Object
 Dim sZlArr() As String, sSpArr() As String, sPathFile As String
 
 sPathFile = "\\netzlaufwerk.com\ordner\quelle.csv" 'Datei anpassen
 Set oZiel = ThisWorkbook.Sheets(3).Range("$B$1")   'Ziel anpassen
 
'Daten in Zeilenarray schaffen
 sZlArr = Split( _
       CreateObject("Scripting.FileSystemObject") _
       .OpenTextFile(sPathFile).ReadAll, vbCrLf)

'Daten zeilenweise ausgeben
 For iZeile = 0 To UBound(sZlArr)
   sSpArr = Split(sZlArr(iZeile), ";")
   If UBound(sSpArr) >= 0 Then
      oZiel.Offset(iZeile, 0).Resize(, UBound(sSpArr) + 1) _
           = Application.Transpose(Application.Transpose(sSpArr))
   End If
 Next iZeile
 
End Sub

____________________

viele Grüße aus Freigericht
Karl-Heinz

[MichaLauterbach]

Hallo Karl-Heinz,



danke für dein Feedback. Dein erster Tipp funktioniert, danke dafür.



Dein zweiter Weg geht nicht, da wird nur im Zielsheet in B1 "ÿþR" eingetragen, sonst nix

[volti]

Hallo Micha,

das ist merkwürdig. 

Wenn Du mit der ersten Variante zufrieden bist, ist's ja ok.

Ansonsten müsste man den zweiten Code mal im Einzelschrift durchgehen und schauen, wo's hängt. Kann ich jetzt ohne nähere Infos und Zugriff auf die Realdatei nix weiter zu sagen. Die Hieroglyphen sind mir vor langer Zeit schon mal untergekommen, krieg's aber grad nicht mehr zusammen.

viele Grüße
Karl-Heinz

[Kuwer]

Hallo,

Dein zweiter Weg geht nicht, da wird nur im Zielsheet in B1 "ÿþR" eingetragen, sonst nix

Ersetze mal den Teil

'Daten in Zeilenarray schaffen
sZlArr = Split( _
      CreateObject("Scripting.FileSystemObject") _
      .OpenTextFile(sPathFile).ReadAll, vbCrLf)

damit:

'Daten in Zeilenarray schaffen
sZlArr = Split( _
      CreateObject("Scripting.FileSystemObject") _
      .OpenTextFile(sPathFile, 1, False, True).ReadAll, vbNewLine)

Gruß Uwe

---

Hallo Karl-Heinz,

Die Hieroglyphen sind mir vor langer Zeit schon mal untergekommen, krieg's aber grad nicht mehr zusammen.

das kam mir auch irgendwie bekannt vor. Liegt wohl an NUL-Strings in Unixdateien. Siehe z.B. hier:
https://administrator.de/forum/vba-erste...93841.html

Gruß Uwe

[volti]

Danke Uwe,

für Deine Hinweise und den Link.

Ist sehr interessant, muss ich mir merken.

Liegt wohl an NUL-Strings in Unixdateien

Merkwürdig ist aber, dass es immer diese drei Zeichen sind, und ob ein Nullstring immer an vierter Stelle kommt



viele Grüße
Karl-Heinz

[MichaLauterbach]

Hallo Uwe, Hallo Karl Heinz,

ich danke euch für das Feedback. Auch mit der Änderung geht es nicht.
Wenn ich auf eine .csv Datei zugreifen will kommt ein Run time error 13 "Type mismatch"
er stört sich an den roten Zeilen

'Daten zeilenweise ausgeben

 For iZeile = 0 To UBound(sZlArr)

   sSpArr = Split(sZlArr(iZeile), ";")

   If UBound(sSpArr) >= 0 Then

      oZiel.Offset(iZeile, 0).Resize(, UBound(sSpArr) + 1) _

           = Application.Transpose(Application.Transpose(sSpArr))

   End If

 Next iZeile


Wenn ich auf eine xlsx Datei zugreifen will kommt statt dem Fehler wieder nur was kryptischen in B1, diesmal aber 䭐Ѓ..... Wenn ich die Range von B1 auf B:T ändere schreibt er die zeichen in jede Spalte B Zelle...
Das ist für mich zu hohe Programmierung, als das ich da irgendwas selber fixen könnte. Variante 1 funktioniert und bin damit zufrieden.

Vielen Dank!

[MichaLauterbach]

Ausage zurück!

Variante 1 funktioniert das werte kopieren, hab jetzt aber bemerkt das bei .value logischerweiße die Zellenfarbe nicht mit übernommen wird, das ist aber wichtig, das die zellfarbe der quelle mit übernommen wird, weil die zeilen die rot sind im anschluss an den import automatisch gelöscht werden.

Also entweder muss ich die Werte mit Hintergrundfarbe übernehmen um sie dann zu löschen, oder ich kopiere/importiere nur zeilen ohne rote hintergrundfarbe.

ThisWorkbook.Sheets(2).Range("B1:H300").Interior.ColorIndex = ActiveWorkbook.Sheets(1).Range("A1:G300").Interior.ColorIndex

funktioniert scheinbar nicht

Kann man die Hintergrundfarbe auch bei Variante 1 übernehmen?

[volti]

Hallo Micha,

wenn auch etwas spät.

In Deinem Beispiel öffnest Du eine CSV-Datei, deshalb hatte ich Dir das erste Beispiel in der Form zur Vereinfachung gezeigt.
Eine CSV-Datei ist eine reine Textdatei und kann außer Text keine Hintergrundfarben oder sonst was enthalten.

Falls Du da jetzt doch gemischte Dateien csv/xlsx einlesen willst, sind die Beispiele nicht tauglich dafür. Da hätten wir dann aneinander vorbei geredet.

Die Übernahme der Hintergrundfarben ist in dieser Form wohl so nicht möglich, da muss über Copy oder mittels Schleife gearbeitet werden. 
Das ist dann aber wieder mehr Aufwand.

viele Grüße
Karl-Heinz