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"