Datenimport

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Datenimport von: Uwe T.
Geschrieben am: 13.02.2005 12:40:33

Hallo,

ich versuche Daten aus einer Excel-Datei in eine Txt.-Datei auszulagern und anschließend wieder zu importieren. Unten aufgeführtes Makro funktioniert, wenn Blattname immer gleich ist. Bei mir ändert sich jedoch ständig der Blattname. Ich muss mich also auf den CodeNamen beziehen, da dieser immer gleich ist.

Wenn die Tabellenblattnamen ("Tabelle1, Tabelle2, etc") sich nicht ändert, dann laufen Export und Import sauber durch.
Wenn ich jedoch nach dem Export den Tabellenblattnamen z.B. in "Name1"; Name2; etc.") abändere, bekommer ich folgende Fehlermeldung:

Laufzeitfehler9 = Index außerhalb des gültigen Bereichs bei "Set wks = Sheets(arr(0))"

Dieser Fehler entsteht m.E. dadurch, dass beim Import nach dem Tabellenblattnamen gesucht wird und nicht nach dem Codenamen.

Ich weiss nur nicht, wie ich die Worksheets bzw. Sheets-Anweisung umschreiben soll und bitte um Unterstützung.

Gruß
Uwe


Option Explicit
Const strRange As String = "A1:L157" 'Datenbereich hier


Sub exportData()
Dim wks As Worksheet
Dim sFile As String, tmp As String
Dim arr As Variant
Dim n As Long, m As Integer
sFile = Application.GetSaveAsFilename(InitialFilename:=".txt", _
                        FileFilter:="Text Dateien (*.txt), *.txt")
    If sFile = "Falsch" Then Exit Sub
On Error GoTo ERRORHANDLER
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
Close #1
Open sFile For Output As #1
   For Each wks In ThisWorkbook.Worksheets
      If LCase(wks.Range("A4")) = "kreditnehmer:" And wks.Visible = xlSheetVisible Then
      'Identifizierung der Tabellen nach Eintrag in "A4" und Blatt = Sichtbar!
      'Natürlich kann man auch eine beliebige andere Zelle verwenden, um den
      'Export zu steuern!
      
      Application.StatusBar = "Export Daten: " & wks.CodeName
      
            
      arr = wks.Range(strRange).FormulaLocal
      
         For m = 1 To UBound(arr, 2)
            For n = 1 To UBound(arr, 1)
            tmp = tmp & "|" & arr(n, m)
            Next
         Next
      
      Print #1, wks.CodeName & tmp
      
      wks.Range(strRange).ClearContents
      
      End If
      
      tmp = vbNullString
      
           
   Next
Close #1
MsgBox "Die Daten wurden erfolgreich Exportiert!"
ERRORHANDLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.StatusBar = False
End With
End Sub








Sub importData2()
Dim wks As Worksheet
Dim sFile As String, tmp As String
Dim arr As Variant
Dim n As Long, m As Integer, i As Integer
Application.ScreenUpdating = False
sFile = Application.GetOpenFilename("Text Dateien (*.txt), *.txt")
    If sFile = "Falsch" Then Exit Sub
On Error GoTo ERRORHANDLER
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
Open sFile For Input As #1
   Do While Not EOF(1)
   Input #1, tmp
   
   arr = Split(tmp, ";")
   For Each wks In Sheets
      If wks.CodeName <> arr(0) Then
         Set wks = Nothing
      Else
         Exit For
      End If
   Next
   
   If wks Is Nothing Then
      Close #1
      MsgBox "Das Tabellenblatt zum Einfügen der Daten wurde gelöscht!"
      Exit Sub
   End If
   
      For n = 1 To 157
         For m = 1 To 12
         i = i + 1
         wks.Cells(n, m) = arr(i)
         Next
      Next
   
   Loop
Close #1
ERRORHANDLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Bild


Betrifft: AW: Datenimport von: Ramses
Geschrieben am: 13.02.2005 12:46:28

Hallo

mal als Tipp:

Lösche im ersten Makro die Zeile

Print #1, wks.CodeName & tmp

und ersetze sie durch

Print #1, tmp


und im zweiten Makro musst du diese Sequenz löschen

For Each wks In Sheets
If wks.CodeName <> arr(0) Then
Set wks = Nothing
Else
Exit For
End If
Next

If wks Is Nothing Then
Close #1
MsgBox "Das Tabellenblatt zum Einfügen der Daten wurde gelöscht!"
Exit Sub
End If


Was das allerdings für Auswirkungen auf deine Daten hat, kann ich dir nicht sagen.
Da solltest du mal zu dem gehen, der dir das makro geschrieben hat.

Gruss Rainer


Bild


Betrifft: AW: Datenimport von: Uwe T.
Geschrieben am: 13.02.2005 13:59:17

Hallo Rainer,

wenn ich in der Import-Funktion die Sektion rauslösche, dann wird der Import nicht mehr ausgeführt.


https://www.herber.de/bbs/user/17987.xls


Ich habe dir mal die Datei eingestellt. In Tabelle2 findest du die Schaltflächen für den Export und den Import. Wenn man das Tabellenblatt Tabelle1 nicht umbenennt, dann funktioniert auch der Import. Sobald man den Namen z.B. in Name1 ändert, kommt die Fehlermeldung. D.h., ich darf das Makro nicht auf den Tabellenblattnamen beziehen, weil es nach Änderung nicht mehr gefunden wird. Wie ich jedoch das Makro so umstelle, dass es sich den Codenamen zieht (der ja konstant bleibt und sich als Suchkriterium eignet), weiss ich nicht.

Ich hoffe, dass du mir weiterhelfen kannst oder vielleicht eine andere Lösung kennst. Wenn dieses Problem gelöst ist, bin ich hoffentlich mit dem Excel-Tool fertig. Ich komme nur bei diesem letzten Schritt nicht weiter und bin fast am verzweifeln. Der Export und der Import sind nötig, weil das Original-Tool rd. 4 MB groß ist und mehrere Personen dieses Tool nutzen sollen. Speichert jeder User die Datei ab, sprengt das die Festplattenkapazität. Daher die Variante, die Daten in eine Txt-Datei auszulagern.

Gruß
Uwe


Bild


Betrifft: AW: Datenimport von: Ramses
Geschrieben am: 13.02.2005 14:18:46

Hallo

Tut mir leid, aber das hilft auch nicht.
Wenn du die richtige Sequenz gelöscht hast, muss das funkionieren, weil dann ohne Rücksicht auf den Tabellennamen mit dem Einlesen gestartet wird.

Dein grundsätzliches Problem ist, dass du den Tabellennamen exportierst !!! und das einlesen eben wieder von diesem Tabellennamen der an Position 0 im Array steht, abhängig machst.

Ich keine dein Tool nicht, aber wenn das einlesen und funktionieren in irgendeiner Weise davon abhängig ist, solltest du bestimmte Vorgaben machen wie die Tabelle aufgebaut und bezeichnet sein muss.

Gruss Rainer


Bild


Betrifft: AW: Datenimport von: Josef Ehrensberger
Geschrieben am: 13.02.2005 20:55:32

Hallo Uwe!

War heute noch nicht im Forum und habe deinen Beitrag erst jetzt gelesen.

Wenn sich das Umbenennen der Tabellen nicht vermeiden lässt, dann ist der
Umweg über den Codenamen sicher Sinnvoll.

Hier ein angepasster Code unter Verwendung der Codenamen.

Wenn die Codenamen der Tabellen die Exportiert werden sollen, einen
unverwechselbaren String enthalten, dann könnte man auch die zu
exportierenden Blätter danach bestimmen!



      
Option Explicit
Const strRange As String = "A8:L157"   'Datenbereich hier anpassen


Sub exportData()
Dim wks As Worksheet
Dim sFile As String, tmp As String
Dim arr As Variant
Dim n As Long, m As Integer

sFile = Application.GetSaveAsFilename(InitialFilename:=
".txt", _
                        FileFilter:=
"Text Dateien (*.txt), *.txt")

    
If sFile = "Falsch" Then Exit Sub

On Error GoTo ERRORHANDLER

With Application
.ScreenUpdating = 
False
.EnableEvents = 
False
.DisplayAlerts = 
False
.Calculation = xlCalculationManual
End With

Close #1

Open sFile For Output As #1

   
For Each wks In ThisWorkbook.Worksheets
      
If LCase(wks.Range("A4")) = "kreditnehmer:" And wks.Visible = xlSheetVisible Then
      
'Identifizierung der Tabellen nach Eintrag in "A4" und Blatt = Sichtbar!
      'Natürlich kann man auch eine beliebige andere Zelle verwenden, um den
      'Export zu steuern!
      
      Application.StatusBar = 
"Export Daten: " & wks.CodeName
      
            
      arr = wks.Range(strRange).FormulaLocal
      
         
For m = 1 To UBound(arr, 2)
            
For n = 1 To UBound(arr, 1)
            tmp = tmp & 
"|" & arr(n, m)
            
Next
         
Next
      
      
Print #1, wks.CodeName & tmp
      
      wks.Range(strRange).ClearContents
      
      
End If
      
      tmp = vbNullString
      
           
   
Next

Close #1

MsgBox 
"Die Daten wurden erfolgreich Exportiert!"

ERRORHANDLER:

With Application
.ScreenUpdating = 
True
.EnableEvents = 
True
.DisplayAlerts = 
True
.Calculation = xlCalculationAutomatic
.StatusBar = 
False
End With

End Sub




Sub importData()
Dim wks As Worksheet
Dim sFile As String, tmp As String
Dim arr As Variant, arr2 As Variant
Dim n As Long, m As Integer, i As Long
Dim strFehler As String, strErfolg As String

sFile = Application.GetOpenFilename(
"Text Dateien (*.txt), *.txt")

    
If sFile = "Falsch" Then Exit Sub

On Error GoTo ERRORHANDLER

With Application
.ScreenUpdating = 
False
.EnableEvents = 
False
.DisplayAlerts = 
False
.Calculation = xlCalculationManual
End With

Close #1
Open sFile For Input As #1
   
Do While Not EOF(1)
   Line 
Input #1, tmp
   
   arr = Split(tmp, 
"|")
   
   
'neu-----------------------------------------------
   Set wks = Nothing
   
   
      
For Each wks In ThisWorkbook.Sheets
      
         
If ThisWorkbook.VBProject.VBComponents(arr(0)).Name = wks.CodeName Then
         
'vergleicht den im Textfile gespeicherten CodeName mit dem CodeName
         'aller Tabellen. Bei Übereinstimmung wird diese Tabelle zugeordnet!
         
         
Set wks = wks
         
         
Exit For
         
         
End If
      
      
Next
   
   
'--------------------------------------------------
   
   
If Not wks Is Nothing Then                'neu-----
   strErfolg = strErfolg & arr(0) & vbLf     'neu-----
   
   Application.StatusBar = 
"Import Daten: " & wks.Name
   
   
ReDim arr2(1 To Range(strRange).Rows.Count, 1 To Range(strRange).Columns.Count)
   
      
      
For m = 1 To UBound(arr2, 2)
         
For n = 1 To UBound(arr2, 1)

         i = i + 1
         arr2(n, m) = arr(i)

         
Next
      
Next

      wks.Range(strRange).FormulaLocal = arr2
      i = 0
      
      
End If                                 '--------
NOSHEET:                                     'neu-----
   Loop
Close #1

If strFehler = "" Then                       'neu-----
MsgBox "Die Daten wurden erfolgreich Importiert!"
Else
MsgBox 
"Die Daten folgender Tabelle(n) wurden importiert!" & Space(10) & _
         vbLf & vbLf & strErfolg & vbLf & vbLf & _
         
"Beim Import dieser Tabelle(n) trat ein Fehler auf!" & _
         vbLf & vbLf & strFehler & vbLf
End If                                       '--------

ERRORHANDLER:

If Err.Number = 9 Then                       'neu-----
Err.Clear
strFehler = strFehler & arr(0) & vbLf
Resume NOSHEET                               '--------
End If

With Application
.ScreenUpdating = 
True
.EnableEvents = 
True
.DisplayAlerts = 
True
.Calculation = xlCalculationAutomatic
.StatusBar = 
False
End With
End Sub 


     Code eingefügt mit Syntaxhighlighter 3.0



Gruß Sepp

P.S.: Rückmeldung nicht vergessen!


 Bild

Beiträge aus den Excel-Beispielen zum Thema "standard gitternetzlinien ausblenden"