Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
564to568
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
564to568
564to568
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datenimport

Datenimport
13.02.2005 12:40:33
Uwe
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

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datenimport
Ramses
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
Anzeige
AW: Datenimport
13.02.2005 13:59:17
Uwe
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
Anzeige
AW: Datenimport
Ramses
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
Anzeige
AW: Datenimport
13.02.2005 20:55:32
Josef
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 


Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige