Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
Kommentar vom Moderator Biber am 01.12.2009 um 18:33:09 Uhr
Für diese IT-typische Formulierung, gepostet am 1.12.2009
Zitat von ffmboy:
Also zum Export der datei hab ich mir das makro hier angepasst funktioniert eigentlich super:
... dafür mache ich bald einen neuen Counter auf....

Vor allem, weil ich bei dieser Einleitung immer schon den Folgesatz erahne...
GELÖST

Suchen-Ersetzen EXCEL Makro?

Frage Microsoft Microsoft Office

Mitglied: ffmboy

ffmboy (Level 1) - Jetzt verbinden

23.11.2009, aktualisiert 18.10.2012, 17072 Aufrufe, 45 Kommentare

Hi !!

Hab folgendes Problem!

Ich habe 2Sheets in einer Mappe: Sheet1 und Sheet2



826e0a8014ec7cff0a0dc57cfefde706-bild2 - Klicke auf das Bild, um es zu vergrößern


usw......

Jetzt möchte ich, dass ein makro für mich die Namen in Sheet1 ersetzt und zwar wie folgt :

Gesucht wird nach C3 aus Sheet2 (Werner) in Sheet1 -> ersetzt wird (Werner) durch den Namer der in B3 in Sheet2 (Uwe)

und das soll für ca 5000 namen geschehen !!!!!

Ich komme einfach mit dem Makro aufzeichnen nicht weiter da ich bei suchen und ersetzen nicht weiß wie ich die zellen verknüpfen kann?????
also dass das makro in sheet1 nach "C3 aus Sheet2" sucht und mit "B3 aus Sheet2" ersetzt!!

*
Das nächste wäre nur als zusatz hab mich noch nicht damit befasst weil ich beim ersetzten nicht weiterkomme!!

Wenn erfolgreich ersetzt wurde sollte in der dazugehörigen (E-Zelle) ein Ja stehen
und wenn nicht ein nein!!

Ich hoffe ihr könnt mir helfen und das ich das problem genau beschrieben habe!!

Danke schon mal im Vorraus an alle!
45 Antworten
Mitglied: justdoit
23.11.2009 um 16:13 Uhr
Auch Hi,

so etwas funktioniert i.d.R. nur über solche Dinge wie suchen/ersetzen, wenndann, sverweis etc. Dafür benötigt man auch kein Makro.
Wenn Du aber nur Vornamen hast, wird Excel alleine schon Probleme haben, sauber die Namen zu finden, denn Wolfgang wird es vermutlich mehr als einmal geben.

Wenn Die Zeilen (Namen) schon alle schön untereinander stehen, kopier doch die Spalte mit den neuen Namen einfach drüber. Damit sind auf jeden Falle alle ersetzt. :o)

Ansonsten benötigst Du auf jeden Fall eine Art Primärschlüssel, und damit ist Access der klar bessere Favorit!

VG
JDI
Bitte warten ..
Mitglied: ffmboy
23.11.2009 um 16:19 Uhr
also das war jezt nur ein beispiel gewesen mit den namen!

1.) es ist so dass jeder name(zeichenfolge) nur einmal vorkommt!

2.) die reihenfolge stimmt nicht

3.) muss mit excel geschehen!

Danke für deine hilfe
Gruß
ffmboy
Bitte warten ..
Mitglied: justdoit
23.11.2009 um 16:58 Uhr
dann wäre der sverweis meine 1. Wahl (ohne Makro).
Du machst in Sheet 1 rechts neben der auszutauschenden Spalte eine neue spalte. Dor legst Du den Sverweis an.
Dann bis ans Ende runterkopieren. Alle Einträge die nicht gefunden werden werden mit #NV gekennzeichnet. Die Filterst Du raus. Dann mit einer wenn Formel beide Spalten in einer neuen Spalte zusammenbringen. Die beiden alten Spalten (alte Namen und die mit dem S.-Verweis) löschen. fertig.
Wenn Du noch das mit Ersetzt ja / Nein benötigst, kannst Du dafür die #NV nehmen.

VG
JDI
Bitte warten ..
Mitglied: 76109
23.11.2009 um 18:34 Uhr
Hallo ffmboy!

Wenn's doch ein Makro sein soll, dann diesen Quelltext im VB-Editor in ein Modul kopieren:
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const Sheet1 = "Tabelle1" 
05.
Const Sheet2 = "Tabelle2" 
06.
 
07.
Sub SearchAndReplace() 
08.
    Dim Wks1 As Worksheet, Wks2 As Worksheet, c As Range, d As Range 
09.
     
10.
    Set Wks1 = Sheets(Sheet1):  Set Wks2 = Sheets(Sheet2) 
11.
     
12.
    For Each c In Wks2.Range("C3:C" & Wks2.Cells(Wks2.Rows.Count, "C").End(xlUp).Row) 
13.
        If Not IsEmpty(c) Then 
14.
            Set d = Wks1.Columns("B").Find(c, LookIn:=xlValues, LookAt:=xlWhole) 
15.
            If d Is Nothing Then 
16.
                c.Offset(0, 1) = "Nein" 
17.
            Else 
18.
                d.Value = c.Offset(0, -1):  c.Offset(0, 1) = "Ja" 
19.
            End If 
20.
        End If 
21.
    Next 
22.
End Sub
Die Namen der Tabellenblätter entsprechend anpassen

Gruß Dieter
Bitte warten ..
Mitglied: ffmboy
24.11.2009 um 13:37 Uhr
Kann mir mal einer kurz erklären was in der 12 und 14 zeile passiert???

12. For Each c In Wks2.Range("C3:C" & Wks2.Cells(Wks2.Rows.Count, "C").End(xlUp).Row)

14. Set d = Wks1.Columns("B").Find(c, LookIn:=xlValues, LookAt:=xlWhole)

der debugger stoppt da das makro!!

kann es daran leigen dass ich eine click() schaltfläche dafür benutze? ich muss auch in anderen macro codes immer ein "ActiveSheet" vor Range setzen wenn ich zellen markieren möchte!!


Bin zwar kein Programmier Typ aber irgendwie fehlt mir in dem Code die sache mit dem ersetzen im sheet1??????
Bitte warten ..
Mitglied: 76109
24.11.2009 um 15:55 Uhr
Hallo ffmboy!

Also, ich nehme mal an, dass die Konstanten Sheet1 und Sheet2 richtig angepasst wurden.

ActiveSheet wird nicht benötigt, da mit den Set-Anweisungen für Wks1 und Wks2 die Tabellenblätter explizit zugewiesen werden.

Die Zeile 12 bedeutet: Durchlaufe in Sheet 2 alle Zellen im Bereich von C3 bis zur letzten Zelle mit Inhalt in Spalte C

Die Zeile 14 bedeutet: Durchsuche in Sheet 1 die Spalte B nach dem Zellinhalt, der in Sheet 2 in der aktuellen Zeile und Spalte C drinsteht.

Die Zeile 16 bedeutet: Zellinhalt in Spalte B in Sheet 1 nicht gefunden, dann schreibe in Sheet 2 aktuelle Zeile Spalte D "Nein"

Die Zeile 18 bedeutet: Zellinhalt in Spalte B in Sheet 1 gefunden, dann ersetze den Zellinhalt mit dem Inhalt der in Sheet 2 in Spalte B steht und schreibe in Sheet 2 Spalte D "Ja"

Also, wenn Deine Vorgaben im Beitrag stimmen, dann sollte es eigentlich funktionieren, zumindest funktioniert es bei mir.

Gruß Dieter
Bitte warten ..
Mitglied: ffmboy
24.11.2009 um 16:42 Uhr
Also als erstes möchte ich dir danken für deine lösung hab es im ersten beitrag vergessen :

ich habe für zeile 4 und 5 folgendes geändert:

Const Sheet1 = "Mein_Sheet_1_Name"
Const Sheet2 = "Mein_Sheet_2_Name"

ansonsten habe ich alles gelassen

das makro schreibt aber in sheet1 spalte d (nein rein) und zwar überall ein nein!!
Bitte warten ..
Mitglied: ffmboy
24.11.2009 um 16:49 Uhr
also ich muss dazu noch was sagen! also die beschreibung des problems war nur als beispiel!

Hab mehrere sheets in der mappe und es werden noch einige dazwischen kommen!
könnte man das beispiel verallgemeinern so dass ich dann nur die Namen der Sheets eintrage????
Bitte warten ..
Mitglied: ffmboy
24.11.2009 um 17:06 Uhr
ok du hast recht bei mir funktioniert es auch an dem beispiel wie ich es vorhin erläutert habe versuche es morgen zu modifizieren so dass es bei meiner richtigen mappe es klappt!
das prinzip ist das selbe

nur das Sheet1 dort (sheet2 ist und "Anders_Heißt1")
und das Sheet2 vorläufig (Sheet4 ist und "Anders_heißt2")
Bitte warten ..
Mitglied: 76109
24.11.2009 um 17:10 Uhr
Zitat von ffmboy:
das makro schreibt aber in sheet1 spalte d (nein rein) und zwar überall ein nein!!
Also, Sheet 2 muss das Tabellenblatt mit den Spalten "Neu" und "Alt" und "Ersetzt" sein. So wie in Deinem Beitrag vorgegeben. Wenn dem so ist, dann kann unmöglich in Sheet 1 in Spalte D was reingeschrieben werden. Das Makro ist explizit nach Deinen Vorgaben geschrieben.

Gruß Dieter
Bitte warten ..
Mitglied: 76109
24.11.2009 um 17:35 Uhr
Hallo nochmal!

Vielleicht solltest Du die Tabellennamen erstmal so anpassen, das es kein Kuddelmuddel gibt. Das ganze soll doch eine einmalige Sache sein oder sehe ich das Falsch. Eventuell wäre es sinnvoll ein neues Tabellenblatt zu erstellen, in dem z.B. pro Zeile in Spalte A und B die jeweiligen Tabellennamen der Sheetpärchen eingetragen werden. Diese Liste könnte dann durch das Makro Zeile für Zeile abgearbeitet werden. Nur so ein Gedanke

Gruß Dieter
Bitte warten ..
Mitglied: ffmboy
25.11.2009 um 08:45 Uhr
ist es möglich das makro so anzupassen dass es nicht unbedingt sheet1 und sheet2 sein müssen??

also das ich es so modifizieren kann dass es nicht unbedingt blatt1 und blatt2 sein müssen!

*
wenn ich auf die tabelle (welche im beispiel sheet1 ist) rechte maus -> code anzeigen: zeigt er mir an das es Tabelle7 ist. in der excel oberfläche habe ich die tabelle auf die 2 stelle vorübergehend verschoben!!

wenn ich auf die tabelle (welche im beispiel sheet2 ist) rechte maus -> code anzeigen: zeigt er mir an das es Tabelle3 ist. in der excel oberfläche habe ich die tabelle auf die 4 stelle vorübergehend verschoben!!
'
*
kannst du mir vielelicht sagen welche parameter/ constante/variablen ich in deinem code wie anpassen muss um das makro nach meinen belieben zu ändern!!

ich hoffe ich hab mich verständlich ausgedruckt!
möchte einfach einen variablen code haben weil es sein kann das ich noch zwischen die Tabellen neue tabellen einfügen müsste!!

Aber an sich ist dein MACRO genau das was ich meinte!!

Gruß ffmboy
Bitte warten ..
Mitglied: 76109
25.11.2009 um 09:03 Uhr
Zitat von ffmboy:
ist es möglich das makro so anzupassen dass es nicht unbedingt sheet1 und sheet2 sein müssen??
Hast Du meine vorletzte Antwort gelesen?
wenn ich auf die tabelle (welche im beispiel sheet1 ist) rechte maus code anzeigen:
zeigt er mir an das es Tabelle7 ist. in der excel
oberfläche habe ich die tabelle auf die 2 stelle vorübergehend verschoben!!
wenn ich auf die tabelle (welche im beispiel sheet2 ist) rechte maus code anzeigen:
zeigt er mir an das es Tabelle3 ist. in der excel
oberfläche habe ich die tabelle auf die 4 stelle vorübergehend verschoben!!
Wozu soll das gut sein?
kannst du mir vielelicht sagen welche parameter/ constante/variablen ich in deinem code wie anpassen muss um das
makro nach meinen belieben zu ändern!!
Was genau willst Du verändern?

Für den Fall, dass sich imer nur 2 Tabellennamen ändern, wäre es wohl am einfachsten, die Sheetnamen per InputBox abzufragen.

Gruß Dieter
Bitte warten ..
Mitglied: ffmboy
25.11.2009 um 11:20 Uhr
Bitte warten ..
Mitglied: ffmboy
25.11.2009 um 11:37 Uhr
OHHHH man sorry ich hatte einen dummen fehler drinn gehabt!!!

Funktioniert alles super was du gemacht hast!!!

Jetzt verstehe ich auch warum du mich nicht verstanden hast!!!

Sorry und danke nochmals!!

Gruß ffmboy
Bitte warten ..
Mitglied: ffmboy
25.11.2009 um 11:55 Uhr
hi hab noch 2 Fragen??

Kann man das suchen und ersetzen so ändern dass es die zellen danach durchsucht und ersetzt auch wenn dabei noch was anderes steht:
zb so:

Sheet1

Namen:
Dicker bernd
dünner wolfgand

Sheet2 :bleibt so erhalten

und nach dem makro:

Sheet1

namen:
Dicker uwe
dünner willy


also das er nur den inhalt überschreibt nach dem gesucht wurde alles andere bleibt stehen??

2Frage:

Wenn ich bsp. im sheet1 einen filter einsetzen würde, würde das suchen und erseztzen nur das gefilterte durchsuchen und bearbeiten oder den kopletten sheet1???

Danke
Mit freundlichen Grüßen
ffmboy
Bitte warten ..
Mitglied: 76109
25.11.2009 um 12:21 Uhr
Zitat von ffmboy:
Kann man das suchen und ersetzen so ändern dass es die zellen
danach durchsucht und ersetzt auch wenn dabei noch was anderes steht:
Ja, das geht, sofern der Name im Sheet nur einmal vorkommt.
2Frage:
Wenn ich bsp. im sheet1 einen filter einsetzen würde, würde
das suchen und erseztzen nur das gefilterte durchsuchen und bearbeiten
oder den kopletten sheet1???
Mit Filter funktioniert das leider nicht.

Gruß Dieter
Bitte warten ..
Mitglied: ffmboy
25.11.2009 um 13:33 Uhr
ja der name würde nur einmal vorkommen.!

Könnte ich dann die gefilterten werte in einer andere tabelle verknüpfen.

Dort die daten ersetzen (so dass es in den ursprungszellen) auch die änderung wirkt!

Dann den Filter Ausschalten, und somit meine ursprünglichen dateiinhalt mit geänderten namen haben!!!
Bitte warten ..
Mitglied: 76109
25.11.2009 um 16:00 Uhr
Hallo ffmboy!

Sorry, aber irgendwie kann ich Dir nicht mehr ganz folgen

Gruß Dieter
Bitte warten ..
Mitglied: ffmboy
25.11.2009 um 16:48 Uhr
Zitat von 76109:
> Zitat von ffmboy:
> Kann man das suchen und ersetzen so ändern dass es die
zellen
> danach durchsucht und ersetzt auch wenn dabei noch was anderes
steht:
Ja, das geht, sofern der Name im Sheet nur einmal vorkommt.

Was müsste ich denn ändern damit es geht???

> 2Frage:
> Wenn ich bsp. im sheet1 einen filter einsetzen würde,
würde
> das suchen und erseztzen nur das gefilterte durchsuchen und
bearbeiten
> oder den kopletten sheet1???
Mit Filter funktioniert das leider nicht.

Gruß Dieter


Du hast ja geschrieben das gefilterte werte nicht durchsucht werden könnten!!

da hab ich mir gedacht das ich eine datei (in excel schon importiert ca. 60000 zeilen)
nach bestimmten namen filter! (bleiben so ca 2000 zellen übrig)

diese gefilterte werte würde ich gerne mit dem macro (Was du geschrieben hast) absuchen/und ersetzen lassen!!!

Da es aber mit gefilterten nicht geht : würde ich diese gerne in einer anderen tabelle verknüpfen dort das macro die werte ändern lassen und somit auch die werte in sheet1 ändern????
geht sowas überhaupt ?????


Ach vergiss es das mit dem verknüpfen und dort ändern bringt nix hab es gerade ausprobiert!!
Bitte warten ..
Mitglied: 76109
25.11.2009 um 17:20 Uhr
Hallo ffmboy!

Also, was die Such/Ersetzen-Funktion bei Filterung angeht, muss ich mich zunächst korrigieren.

Bei meinem 1. Test hatte ich keine Überschriftenzeile und da gab's Probleme. Bei einem Test mit Überschriftzeilen hat es dann doch funktioniert.

Aber trotzdem habe ich den Überblick verloren und weiß nicht, was ich jetzt Sheet 1 und Sheet 2 zuordnen soll.
Welches Sheet soll jetzt gefiltert werden, das mit "Neu, Alt, Ersetzen" oder das andere?
Der Einfacheit halber sollten wir das Sheet mit "Neu, Alt, Ersetzen" Sheet "Suchen" und das andere "Ersetzen" nennen.

Das andere mit der Teil-Suchen/Ersetzen-Funktion folgt noch.

Gruß Dieter
Bitte warten ..
Mitglied: 76109
25.11.2009 um 17:44 Uhr
Hallo ffmboy!

Hier der Code mit Teil-Ersetzen (Zeile 14 und Zeile 18 geändert):
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const Sheet1 = "Tabelle1" 
05.
Const Sheet2 = "Tabelle2" 
06.
 
07.
Sub SearchAndReplace() 
08.
    Dim Wks1 As Worksheet, Wks2 As Worksheet, c As Range, d As Range 
09.
     
10.
    Set Wks1 = Sheets(Sheet1):  Set Wks2 = Sheets(Sheet2) 
11.
     
12.
    For Each c In Wks2.Range("C3:C" & Wks2.Cells(Wks2.Rows.Count, "C").End(xlUp).Row) 
13.
        If Not IsEmpty(c) Then 
14.
            Set d = Wks1.Columns("B").Find(c, LookIn:=xlValues, LookAt:=xlPart) 
15.
            If d Is Nothing Then 
16.
                c.Offset(0, 1) = "Nein" 
17.
            Else 
18.
                d.Value = Replace(d, c, c.Offset(0, -1)):  c.Offset(0, 1) = "Ja" 
19.
            End If 
20.
        End If 
21.
    Next 
22.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: ffmboy
26.11.2009 um 10:36 Uhr
das mit der zeile 14 hab ich mir schon gedacht das man da am ende was ändern muss hab nur zurzeit kein gutes Buch zurhand um da nachzuschauen.

Whole hat ja ganze zelle bedeutet und part heißt wohl das es ein teil sein soll!!

Die 18 hab ich jetzt auch verstanden !!

Danke dir Das funktioniert einwandfrei sogar für das gefilterte zeug!!!

Also bei mir war folgendes!!!

1:Datei importieren (datei hatte in sheet (ersetzen) dann ca 60000 zeilen

2:In sheet(ersetzen) habe ich einen filter eingebaut nach bestimmten muster die zellen gefiltert hat wo die namen stehen
(der filter war notwendig weil die namen in der datei(sheet ersetzen) auch wo anders stehen dort sollten sie aber nicht geändert werden)

3: eine tabelle (Sheet suchen) wird importiert wo die namen: Neu und alt nebeneinander schon stehen!

4: dass sollte das makro was du geschrieben hast die namen ersetzen (im sheet ersetzen)

5: Filter ausschalten

6: Datei unter anderem namen speichern und das wars!!!

also Super vielen dank nochmals!!

Gruß Viktor
Bitte warten ..
Mitglied: 76109
26.11.2009 um 11:43 Uhr
Hallo Viktor!

Zitat von ffmboy:
Whole hat ja ganze zelle bedeutet und part heißt wohl das es ein teil sein soll!!
Das ist korrekt

Jetzt habe ich endlich auch verstanden, was Du genau machst und das es funktioniert, freut mich

Gruß Dieter
Bitte warten ..
Mitglied: ffmboy
26.11.2009 um 12:13 Uhr
eine frage hab ich noch und zwar wo finde ich denn eine gute beschreibung wie ich einen berreich in einem sheet als txt exportieren kann

ich denke mal das es über GetSaveFilename oder so ähnlich geht !!

würde gerne das Thema in vba dazu kennen um irgendwie danach zu stöbern! um mir das makro aufzubauen!

Sollte einfach nur einen berreich in einem sheet speichern können, der pfad, der dateiname und die dateiendung sollte ich selber auswählen(bzw bestimmen) können!

was ich nicht verstehe warum bei mir in der Symbolleiste Liste die fläche XML-Daten Exportieren nicht funktioniert??????
wollte es über ein makro aufzeichnen????
Bitte warten ..
Mitglied: 76109
26.11.2009 um 17:07 Uhr
Hallo Viktor!

Also, in meiner Excel-Version gibt es kein Symbol für XML-Export.

Und keine Ahnung, wo Du vernünftige Beschreibungen zu einzelnen Funktionen findest. Bei Bedarf blättere ich den Object-Katalog durch und suche was ich brauche bzw. gebe entsprechende Begriffe in die Suchmaske ein.

Der nachfolgende Code ermöglicht Dir per Auswahl den Export eines markierten Bereichs in das CSV- oder XML-Format.
Dieser Code erlaubt aber nur eine Marierung in der Form z.B. Range(A5:H12), also keine Spalten/Zeilen-Markierung oder mehrere Blöcke.

Der Ablauf ist in etwa so:
Prüfe ob ein zusammenhängender Bereich markiert, der mehr als eine Zelle enthält.
Erstelle eine neue Temporäre-Arbeitsmappe und kopiere den markierten Bereich in die Zelle A1 von Sheet 1.
Gib einen Dialog "Speichern unter" (*.csv, *.xml) aus, speichere im entsprechenden Format und schließe die Temporäre-Arbeitsmappe.

Eine Sache, die ich mir jedoch nicht erklären kann, ist die, dass die CSV-Datei mit Kommata anstatt Semilikon erstellt wird?

Den Rest kannst Du ja nach Deinen Wünschen anpassen:
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const Msg1 = "Es wurde kein gültiger Bereich markiert!" 
05.
 
06.
Sub ExportFunction() 
07.
    Dim Wks As Worksheet, Wkb As Workbook, Target As String, WkbPath As Variant 
08.
     
09.
    Target = Selection.Address 
10.
     
11.
    If InStr(Target, ":") = 0 Or UBound(Split(Target, "$")) <> 4 Then 
12.
        MsgBox Msg1, vbExclamation, "Fehler":  Exit Sub 
13.
    End If 
14.
     
15.
    Set Wks = ActiveWorkbook.ActiveSheet:  Set Wkb = Workbooks.Add 
16.
     
17.
    Wks.Range(Target).Copy Destination:=Wkb.ActiveSheet.Range("A1") 
18.
    
19.
    WkbPath = Application.GetSaveAsFilename(InitialFileName:="Export", _ 
20.
                    fileFilter:="CSV (*.csv),*.csv,XML (*.xml), *.xml") 
21.
                     
22.
    Application.DisplayAlerts = False 
23.
     
24.
    If WkbPath = False Then 
25.
        Wkb.Saved = True 
26.
    ElseIf WkbPath Like "*.csv" Then 
27.
        Wkb.SaveAs WkbPath, xlCSV 
28.
    ElseIf WkbPath Like "*.xml" Then 
29.
        Wkb.SaveAs WkbPath, xlXMLSpreadsheet 
30.
    Else 
31.
        Wkb.Saved = True 
32.
    End If 
33.
 
34.
    Wkb.Close 
35.
    Application.DisplayAlerts = True 
36.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: ffmboy
01.12.2009, aktualisiert 18.10.2012
Danke Dieter !

hab das mit dem speichern der datei gelöst problem ist dass beim speichern die meißten semikolon wegbleiben!!
Jetzt hab ich gemerkt das die semikolon schon beim hereinladen des dateiinhaltes in excel vernachlässigt werden!!

unter folgendem link ist das gesamte thema:
Dort unten ist auch mein jetziger code würde gerne wissen wie man eine Text Datei ins excel importiert so dass alle zeichen semikolon, sternchen, etc.. also die komplette text datei zeile für zeile importiert wird und kein zecihen weggelassen wird??

http://www.administrator.de/forum/datei-import-ins-aktive-sheet-per-mak ...

danke
Gruß Viktor
Bitte warten ..
Mitglied: ffmboy
01.12.2009 um 10:23 Uhr
Also zum Export der datei hab ich mir das makro hier angepasst funktioniert eigentlich super:


01.
Private Sub Export_to_New_A2L_File_Click() 
02.
         
03.
Dim Bereich As Object, Zeile As Object, Zelle As Object 
04.
Dim strTemp As String 
05.
Dim strDateiname As String 
06.
Dim strTrennzeichen As String 
07.
Dim strMappenpfad As String 
08.
 
09.
strMappenpfad = ActiveWorkbook.FullName 
10.
strMappenpfad = Replace(strMappenpfad, ".xls", ".txt") 
11.
 
12.
strDateiname = InputBox("Wie soll die TXT-Datei heißen (inkl. Pfad)?", "CSV-Export", strMappenpfad) 
13.
If strDateiname = "" Then Exit Sub 
14.
 
15.
strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ",") 
16.
If strTrennzeichen = "" Then Exit Sub 
17.
 
18.
Set Bereich = ActiveSheet.Range("C7:C55416") 
19.
 
20.
Open strDateiname For Output As #1 
21.
 
22.
For Each Zeile In Bereich.Rows 
23.
For Each Zelle In Zeile.Cells 
24.
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then 
25.
 
26.
'Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen 
27.
 
28.
strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen 
29.
Else 
30.
strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen 
31.
End If 
32.
Next 
33.
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1) 
34.
Print #1, strTemp 
35.
strTemp = "" 
36.
Next 
37.
 
38.
Close #1 
39.
Set Bereich = Nothing 
40.
MsgBox "Datei wurde exportiert nach" & vbCrLf & strDateiname 
41.
 

exportiert die datei auch so wie sie im Sheet steht mit allen semikolon und so wieter das problem liegt jetzt beim import der datei wie ich ja einen beitrag höher beschrieben habe wenn ich es schaffa die datei so zu laden wie sie ist sollte dieses makro die datei auch so speichern (nur halt mit geänderten namen)


[Edit Biber] Codetags nachgetragen. Aber ich habe auch statt dessen das Löschen des Kommentars erwogen.
@ffmboy: beim nächsten Mal ohne Codetags... [/Edit]
Bitte warten ..
Mitglied: 76109
01.12.2009 um 18:18 Uhr
Hallo Viktor!

Oha, dass scheint ja ein endloser Thread zu werden

Also, wenn ich Dich richtig verstehe, dann funktioniert Deine Export-Funktion, aber Deine Import-Funktion mit QueryTable nicht so richtig? Wenn ja, dann poste mal den aktuellen Code dazu, aber bitte mit Code-Tags. Biber war ja so nett und hat Deinen letzten Code in Code-Tags gesetzt

Zunächst würde ich Dir, wie von bastla im anderen Thread bereits erwähnt, auch empfehlen für Dateioperationen das neuere FileSystemObject zu verwenden.

Am besten, Du importierst die Bibliothek in Deine Excel-Datei wie folgt:
<VB-Editor><Ansicht Objectkatalog><Klassen><Rechtsklick Verweise><Microsoft Scripting Runtime><Häkchen><OK>
Dann siehst Du die umfangreichen FileSystemObject-Funktionen in den den Klassen <FileSystemObject> und <TextStream>

Code-Beispiel:
01.
Dim Fso As New FileSystemObject, File As TextStream 
02.
Set File = Fso.OpenTextFile(...)
CSV-Export mit Nicht-Ascii-Zeichen Chr(1) als Trennzeichen:
01.
Const Default = "C7:C55416" 
02.
 
03.
Const Msg1 = "Bitte den kompletten Dateipfad angeben:" 
04.
Const Msg2 = "Bitte den Exportbereich im Format 'C7:H17' angeben:" 
05.
Const Msg3 = "Die Eingaben waren unvollständig!" 
06.
Const Msg4 = "Der Exportvorgang ist abgeschlossen!" 
07.
 
08.
Private Sub Export_Click() 
09.
    Dim Fso As Object, File As Object, TextArray As Variant 
10.
    Dim Bereich As Range, Zeile As Range, Zelle As Range 
11.
    Dim Dateipfad As String, Mappepfad As String, RngExport As String 
12.
    Dim SpalteBeg As Integer, SpalteEnd As Integer 
13.
     
14.
    Mappepfad = ThisWorkbook.FullName 
15.
    Mappepfad = Replace(Mappepfad, ".xls", ".csv") 
16.
     
17.
    Dateipfad = InputBox(Msg1, "CSV-Export", Mappepfad) 
18.
    RngExport = InputBox(Msg2, "CSV-Export", Default) 
19.
     
20.
    If Dateipfad = "" Or RngExport = "" Then 
21.
        MsgBox Msg3, vbExclamation, "CSV-Export": Exit Sub 
22.
    End If 
23.
     
24.
    Set Bereich = Range(RngExport) 
25.
     
26.
    SpalteBeg = Bereich.Column 
27.
    SpalteEnd = SpalteBeg + Bereich.Columns.Count - 1 
28.
     
29.
    ReDim TextArray(SpalteBeg To SpalteEnd) As String 
30.
     
31.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
32.
    Set File = Fso.CreateTextFile(Dateipfad) 
33.
     
34.
    For Each Zeile In Bereich.Rows 
35.
        For Each Zelle In Zeile.Cells 
36.
            TextArray(Zelle.Column) = Zelle.Text 
37.
        Next 
38.
        File.WriteLine Join(TextArray, Chr(1)) 
39.
    Next 
40.
     
41.
    File.Close:  Set Fso = Nothing 
42.
     
43.
    MsgBox Msg4, vbInformation, "CSV-Export" 
44.
End Sub
Gruß Dieter

[edit] Code komplett geändert am 03.12 [/edit]

Mit diesen Codes sollten die Import/Export-Funktionen jetzt funktionieren. Als Trennzeichen, wird jetzt ein Nicht-Ascii-Zeichen verwendet, dass in den Zellinhalten normalerweise nicht vorkommen sollte.

Der Export-Bereich wird nun per InputBox abgefragt und als Dateiformat wird *.CSV genommen.
Bitte warten ..
Mitglied: 76109
01.12.2009 um 22:40 Uhr
Hallo Viktor!

Passend zum Export-Code den dazugehörigen Import-Code.

CSV-Import mit Nicht-Ascii-Zeichen Chr(1) als Trennzeichen:
01.
Const Default = "C7" 
02.
 
03.
Const Msg1 = "Bitte die erste Zelle im Format 'C7' angeben:" 
04.
Const Msg2 = "Die Eingaben waren unvollständig!" 
05.
 
06.
Private Sub Import_Click() 
07.
    Dim Dateipfad As Variant, RngImport As String 
08.
      
09.
    Dateipfad = Application.GetOpenFilename("CSV (*.csv),*.csv") 
10.
     
11.
    RngImport = InputBox(Msg1, "CSV-Import", Default) 
12.
     
13.
    If Dateipfad = False Or RngImport = "" Then 
14.
        MsgBox Msg2, vbExclamation, "CSV-Import":  Exit Sub 
15.
    End If 
16.
     
17.
    Application.ScreenUpdating = False 
18.
     
19.
    ActiveSheet.Cells.ClearContents 
20.
     
21.
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Dateipfad, Destination:=Range(RngImport)) 
22.
        .AdjustColumnWidth = True  'Spaltenbreite automatisch anpassen True/False 
23.
        .TextFilePlatform = 1252 
24.
        .TextFileTextQualifier = xlTextQualifierNone 
25.
        .TextFileParseType = xlDelimited 
26.
        .TextFileOtherDelimiter = Chr(1) 
27.
        .Refresh BackgroundQuery:=False 
28.
        .Delete 
29.
    End With 
30.
    Application.ScreenUpdating = True 
31.
End Sub
Gruß Dieter

[edit] Code komplett geändert am 03.12 [/edit]

Der Import-Bereich wird nun per InputBox abgefragt und als Dateiformat wird *.CSV genommen.

Hinsichtlich von QueryTables sei noch zu erwähnen, dass QueryTable (Add) bei jedem Import eine Abfrage speichert. Wenn Du in Deine Excel-Datei z.B. 1000 mal immer die gleiche Datei mit gleichem Inhalt importierst, wird die Excel-Datei wundersamer Weise mit jeder Abfrage größer und größer. Im QueryTable-Code habe ich bereits einen Löschbefehl mit eingebunden, der aber nur die aktuelle Abfrage löscht. Ob Abfragen gespeichert sind, kannst Du sehen, wenn Du in Deinem Import-Sheet in Zelle C7 einen Rechtsklick machst und dort das rote Ausrufezeichen mit dem Text "Daten aktualisieren" steht.

Wenn dem so ist, dann kannst Du mit diesem Code alle Abfragen im aktiven Arbeitsblatt löschen:
01.
Private Sub QueryTablesDelete() 
02.
    Dim QT As QueryTable 
03.
    For Each QT In ActiveSheet.QueryTables:  QT.Delete:  Next 
04.
End Sub
Ausserdem wäre es sinnvoll, falls die Möglichkeit dazu besteht, eine komplett neue Excel-Datei zu erstellen. Eventuell ist Deine Excel-Datei durch die Code-Veränderungen und unzähligen QueryTables-Abfragen sehr stark fragmentiert (wundersame Dateigröße?).
Bitte warten ..
Mitglied: ffmboy
02.12.2009 um 10:31 Uhr
Hi danke für die Mühe aber das Funktioniert auch net so wie ich das möchte!!


Also ich möchte eine Datei so könnte der inhalt aussehen:

"blablabla "
"/blublublublu """" "
" "
" /qöleikbqvöeqiuvbeql """" "
" "
" /wödkcf bwlczqwblciub "
" "
" "
" /*/ "
" /* wcdlhwcflqwieucbwc */ "
" /*/ "


usw...........
das Macro soll eonfach zeile für zeile in excel einfügen(Importieren) heißt:
"blablabla " steht in C7
"/blublublublu """" " steht in C8
" " steht in C9
" /qöleikbqvöeqiuvbeql """" " steht in C10
" " steht in C11
" /wödkcf bwlczqwblciub " steht in C12
" " steht in C13
" " steht in C14
" /*/ " steht in C15
" /* wcdlhwcflqwieucbwc */ " steht in C16
" /*/ " steht in C17

usw....

es ist mir wurscht ob es als text, string, und sonst was importiert wird hauptsache es steht zeichen für zeichen richtig in der jewaligen zelle!
Es sind auch nicht in jeder zeile der datei semikolon gesetzt diese text datei hat keine besondere struktur ist aber sau lang um die 65000 zeilen
Und natürlich sollte ich die zellen danach in excel bearbeiten können und dann wieder so exportieren wie sie in excel steht ohne hinzufügen von semikolon und sonst welchen zeichen bzw. leerzeichen!!!
Bitte warten ..
Mitglied: ffmboy
02.12.2009 um 10:59 Uhr
01.
 
02.
Sub Makro9() 
03.
 
04.
    ChDir "C:\Documents and Settings\My Documents\EXCEL\tests" 
05.
    Workbooks.OpenText Filename:= _ 
06.
        "C:\Documents and Settings\uidt1377\My Documents\EXCEL\tests\test.txt", _ 
07.
        Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone _ 
08.
        , ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:= _ 
09.
        False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _ 
10.
        TrailingMinusNumbers:=True 
11.
    Columns("A:A").EntireColumn.AutoFit 
12.
End Sub 
13.
 
dieses macro hab ich aufgezeichnet ! Es fügt die datei genau so ein wie ich das möchte nur ist der pfad der datei in dem macro fest wie änder ich ihn um selber nach der datei zu suchen (bzw. die datei selber auswählen)?
Und das er mir den inhalt nicht in eine neue mappe schreibt sondern ins activesheet (oder durch angabe eines sheet-namen) ab der zelle C7 einfügt
Bitte warten ..
Mitglied: 76109
02.12.2009 um 15:17 Uhr
Hallo Viktor!

Dein Beispiel mit den chaotischen DoppelQuote-Strings hättest Du auch etwas früher posten können

Bleibt jetzt noch die Frage zu klären, ob Du jetzt immer nur eine Spalte oder mehrere Spalten importierst/exportierst?

Wenn es mehrere Spalten sind, dann musst Du ein Trennzeichen wählen, dass nicht in den Zellen vorkommt oder eine feste Spaltenbreite vorgeben (max Anzahl Zeichen) . Soll grundsätzlich nur in Spalte C kopiert werden und sind in anderen Spalten ein Inhalt der erhalten bleiben soll/muss???

Gruß Dieter
Bitte warten ..
Mitglied: ffmboy
03.12.2009 um 13:44 Uhr
Hi Dieter!

Also es soll ab spalte C nach unten eingefügt werden also dass es dann C60000 ende ist (nur beispiel) sind so ca 57000 zeilen in der text datei!!
In dem sheet wo es importiert werden soll gibts keinen weiteren inhalt!!

Ich weiß garnicht was für ein trennzeichen ich wählen soll??
Warum importiert das macro was ich aufgezeichnet habe ohne angabe von trennzeichen?
Könnte man diese delimiter usw... einstellungen für andere import funktionen benutzen??

boahh hab am anfang garnicht dran gedacht dass excel diese trennzeichen usw.. benötigt dachte wenn ich eine datei importiere er mir diese auch so importiert wie sie auch geschrieben steht zeile für zeile!!

Hab jetzt bei deinem code für import zb.. 6 aufeinanderfolgende kommas als trennzeichen eingesetzt das funktioniert doch er läßt die semikolon raus!!!
Bitte warten ..
Mitglied: 76109
03.12.2009 um 13:51 Uhr
Hallo Viktor!

Sie oben, die Codes wurden komplett geändert und sollten Deinen Wünschen jetzt entsprechen.

Und das nächste mal bitte präzise formulieren und einen nicht mit etwaiigen Codes total verwirren

Gruß Dieter
Bitte warten ..
Mitglied: ffmboy
03.12.2009 um 14:36 Uhr
Hi Dieter!

Also ob du es mir glaubst oder nicht es funktioniert zu 99%

zb: in der zeile 60 in der text datei steht folgender text:

" ksjdcasdkuz" ladfvflkvkf" "ödfvjdavnöfo"

dann importiert mir das macro :
" ksjdcasdkuz" ladfvflkvkf" in C67 und "ödfvjdavnöfo" in D67

also nach einem tab wechselt er die spalten !

Wo kann ich denn in deinem code die angabe der trennzeichen ändern zb 6 kommas als beispiel!!!!
oder tabulator als trennzeichen auch ausschalten!!

Sorry ich weiß das nervt aber ich hab selber langsam keine nerven mehr dafür hätte nie gedacht das einfaches importieren so viel hickhack erfordert!!!
Bitte warten ..
Mitglied: 76109
03.12.2009 um 15:15 Uhr
Hallo Viktor!

Ich glaub mich tritt ein Pferd

Das geht leider nicht, weil QueryTable nur 1 Zeichen akzeptiert.

Öffne mal eine leere Excel-Datei und gehe auf <Einfügen><Symbol> da wird eine Zeichentabelle angezeigt. In dem Feld unten rechts wählst Du <ASCII(Hex)>, dann blätterst Du mal gegen Ende der Tabelle durch und sieh nach ob da vielleicht ein Zeichen dabei ist, dass nicht in Deinen Strings vorkommen könnte.

Wenn Du eins gefunden hast, dann ersetze im Export-Code Zeile 38 Chr(1) gegen Chr(&HZeichencode) z.B. 00B6 = Chr(&HB6) aus und im Import-Code in Zeile 26 machst Du das gleiche in grün.

Gruß Dieter

PS. Der Code ist so geschrieben, dass auch mehrere Spalten exportiert/importiert werden, damit auch andere etwas damit anfangen können und solltest Du nichts finden, dann ändere ich das ganze so, dass nur eine Spalte exportiert/imporiert wird, wenns tatsächlich immer nur eine Spalte sein soll.
Bitte warten ..
Mitglied: ffmboy
03.12.2009 um 15:38 Uhr
Hi Dieter!

Nach einigen grauen Haaren und kaputten Nerven hab ich es geschafft das ganze so zu verbinden dass es jetzt klappt!!
Hoffentlich muss nur noch den test machen was verändern wieder exportieren und die neue mit der alten textdatei mit beyound compare vergleichen sollte mir dann ja nur die paar zeilen anzeigen wo ich auch was geändert habe!!
Hier ist der Vollständige code hab von deinem nur ein paar zeilen übernommen:


01.
Private Sub Search_and_Import_Whole_TXT_File_Click() 
02.
 
03.
Dim datei1$ 
04.
 
05.
Application.ScreenUpdating = False 
06.
datei1 = Application.GetOpenFilename("TXT-Datei (*.txt),*.txt") 
07.
If CStr(datei1) = CStr(False) Then 
08.
    MsgBox "Sie haben keine Datei ausgewählt!", 48, "No File selected" 
09.
    Exit Sub 
10.
End If 
11.
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & datei1, _ 
12.
Destination:=Range("C7")) 
13.
.TextFilePlatform = 1252 
14.
.TextFileTextQualifier = xlTextQualifierNone 
15.
.TextFileConsecutiveDelimiter = False 
16.
.TextFileTabDelimiter = False 
17.
.TextFileSemicolonDelimiter = False 
18.
.TextFileCommaDelimiter = False 
19.
.TextFileSpaceDelimiter = False 
20.
.TextFileOtherDelimiter = Chr(1) 
21.
.Refresh BackgroundQuery:=False 
22.
 
23.
End With 
24.
 
25.
Sheets("TXT_File_Import").Columns("C:C").ColumnWidth = 160 
26.
 
27.
End Sub 
28.
 
hatte vorher die 2 zeilen nicht gehabt
01.
 .TextFilePlatform = 1252 
02.
.TextFileTextQualifier = xlTextQualifierNone
und in dieser zeile = False stehen gehabt deswegen hat er mir ständig nach einem Großen F die spaltentrennung vollzogen
01.
.TextFileOtherDelimiter = Chr(1)
Also nochmals Vielen Vielen Dank für deine Mühe und Hilfe

Gruß
Viktor
Bitte warten ..
Mitglied: 76109
03.12.2009 um 15:53 Uhr
Hallo Viktor!

Gottseidank

Der Standardwert aller Delimiter ist False. Du musst diese also Code nicht nochmal auf False setzen.

Gruß Dieter
Bitte warten ..
Mitglied: ffmboy
03.12.2009 um 16:02 Uhr
Zitat von 76109:
Hallo Viktor!

Ich glaub mich tritt ein Pferd

Das geht leider nicht, weil QueryTable nur 1 Zeichen akzeptiert.

Öffne mal eine leere Excel-Datei und gehe auf
<Einfügen><Symbol> da wird eine Zeichentabelle
angezeigt. In dem Feld unten rechts wählst Du <ASCII(Hex)>,
dann blätterst Du mal gegen Ende der Tabelle durch und sieh nach
ob da vielleicht ein Zeichen dabei ist, dass nicht in Deinen Strings
vorkommen könnte.

Wenn Du eins gefunden hast, dann ersetze im Export-Code Zeile 38
Chr(1) gegen Chr(&HZeichencode) z.B. 00B6 = Chr(&HB6) aus und
im Import-Code in Zeile 26 machst Du das gleiche in grün.

Gruß Dieter

PS. Der Code ist so geschrieben, dass mehrere Spalten
exportiert/importiert werden können und solltest Du nichts
finden, dann ändere ich das ganze so, dass nur eine Spalte
exportiert/imporiert wird, wenns tatsächlich immer nur eine
Spalte sein soll.

Hallo Dieter!
Meinst du jetzt zeile für zeile bis zur dateiende importiert bzw. exportiert wird oder nur eine zeile und das wars??
Falls es zeile für zeile bis zum ende wäre das besser für mich! sowohl import als auch export möchte nämlich nicht von zeichen abhängig sein!
Ich hab zwar ein Zeichen gefunden ~ die heilige welle wird nirgends gebraucht!! Gott sei dank!!!
Gruß
Viktor
Bitte warten ..
Mitglied: ffmboy
03.12.2009 um 16:04 Uhr
Hi
Hab dir oben in deinem letzten Beitrag ein Zitat reingeschrieben!!
Bitte warten ..
Mitglied: 76109
03.12.2009 um 17:16 Uhr
Hallo Viktor!

Na, Du bist mir vielleicht ein Scherzkeks

Natürlich alle Zeilen Aber ich kann mir beim besten Willen nicht vorstellen, dass Deine Text-Strings ein CHR(1)-Zeichen beinhalten, weil es eben nun mal kein ASCII-Zeichen ist.

Wenn ich die Zeit dazu habe, werde ich noch was anderes und einfacheres coden, was dann aber nur 1 Spalte exportiert und importiert.

Gruß Dieter
Bitte warten ..
Mitglied: 76109
04.12.2009 um 00:09 Uhr
Hallo Viktor!

Hier eine einfachere Export/Import-Funktion im Format *.Txt In der Hoffnung, dass es nicht nur bei mir funktioniert?

Export:
01.
Option Explicit 
02.
 
03.
Const Zeile1 = 7 
04.
Const Spalte = "C" 
05.
 
06.
Const Msg1 = "Bitte den kompletten Dateipfad angeben:" 
07.
Const Msg2 = "Es wurde keine Datei angegeben!" 
08.
Const Msg3 = "Der Exportvorgang ist abgeschlossen!" 
09.
 
10.
Private Sub Export_Click() 
11.
    Dim Fso As Object, File As Object, Zelle As Range, Text As String 
12.
    Dim Dateipfad As String, Mappepfad As String, EndLine As Long 
13.
     
14.
    Mappepfad = ThisWorkbook.FullName 
15.
    Mappepfad = Replace(Mappepfad, ".xls", ".txt") 
16.
     
17.
    Dateipfad = InputBox(Msg1, "Text-Export", Mappepfad) 
18.
     
19.
    If Dateipfad = "" Then MsgBox Msg2, vbExclamation, "Text-Export":  Exit Sub 
20.
     
21.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
22.
    Set File = Fso.CreateTextFile(Dateipfad) 
23.
     
24.
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row 
25.
     
26.
    For Each Zelle In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte)) 
27.
        File.WriteLine Zelle.Text 
28.
    Next 
29.
     
30.
    File.Close:  Set Fso = Nothing 
31.
     
32.
    MsgBox Msg3, vbInformation, "Text-Export" 
33.
End Sub
Import:
01.
Option Explicit 
02.
 
03.
Const Zeile1 = 7 
04.
Const Spalte = "C" 
05.
 
06.
Const Msg = "Es wurde keine Datei angegeben!" 
07.
 
08.
Private Sub Import_Click() 
09.
    Dim Fso As Object, File As Object, Dateipfad As Variant, Zeile As Long 
10.
     
11.
    Dateipfad = Application.GetOpenFilename("Text (*.txt),*.txt") 
12.
     
13.
    If Dateipfad = False Then 
14.
        MsgBox Msg, vbExclamation, "Text-Import":  Exit Sub 
15.
    End If 
16.
     
17.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
18.
    Set File = Fso.OpenTextFile(Dateipfad) 
19.
     
20.
    Zeile = Zeile1 
21.
     
22.
    ActiveSheet.Columns(Spalte).Cells.ClearContents 
23.
     
24.
    Application.ScreenUpdating = False 
25.
     
26.
    Do Until File.AtEndOfStream 
27.
        Cells(Zeile, Spalte) = File.ReadLine:  Zeile = Zeile + 1 
28.
    Loop 
29.
     
30.
    Application.ScreenUpdating = True 
31.
     
32.
    File.Close:  Set Fso = Nothing 
33.
End Sub
Die Letzte Zeile mit Inhalt in Spalte C wird automatisch ermittelt.

Gruß Dieter
Bitte warten ..
Mitglied: ffmboy
10.12.2009 um 11:26 Uhr
Ich danke dir für deine komplette Mühe !!
hast mir sehr sehr viel geholfen!!
Mindestens Platin Medallie

Gruß Viktor
Bitte warten ..
Mitglied: 76109
10.12.2009 um 13:26 Uhr
Hallo Viktor!

Zitat von ffmboy:
Ich danke dir für deine komplette Mühe !!
hast mir sehr sehr viel geholfen!!
Mindestens Platin Medallie
Na, dann bin ich auch zufrieden und vielen Dank für die Medallie. Und gleich in Platin

Gruß Dieter
Bitte warten ..
Neuester Wissensbeitrag
CPU, RAM, Mainboards

Angetestet: PC Engines APU 3a2 im Rack-Gehäuse

(1)

Erfahrungsbericht von ashnod zum Thema CPU, RAM, Mainboards ...

Ähnliche Inhalte
Microsoft Office
gelöst Excel-Makro (7)

Frage von yuki13 zum Thema Microsoft Office ...

Microsoft Office
gelöst Excel Makro : Erst prüfen bei erfolgreicher IF einen Wert überschreiben (4)

Frage von Matze1508 zum Thema Microsoft Office ...

Batch & Shell
Suchen, Ersetzen und Entfernen von Dateiinhalten auf Textbasis (1)

Frage von DanteManor zum Thema Batch & Shell ...

Microsoft Office
gelöst Excel Makro - Button "Springe zu Zeile mit heutigem Datum" (5)

Frage von hannsgmaulwurf zum Thema Microsoft Office ...

Heiß diskutierte Inhalte
Grafikkarten & Monitore
Win 10 Grafikkarte Crash von Software? (13)

Frage von Marabunta zum Thema Grafikkarten & Monitore ...

DSL, VDSL
DSL-Signal bewerten (13)

Frage von SarekHL zum Thema DSL, VDSL ...

Switche und Hubs
Trunk für 2xCisco Switch. Wo liegt der Fehler? (9)

Frage von JayyyH zum Thema Switche und Hubs ...

Windows Server
Mailserver auf Windows Server 2012 (9)

Frage von StefanT81 zum Thema Windows Server ...