Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1212to1216
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
Inhaltsverzeichnis

xyz-Datei öffnen und Suchen/Ersetzen

xyz-Datei öffnen und Suchen/Ersetzen
Manuela
Hallo!
Ich bin schon (fast) den ganzen Tag am Testen, aber ich bekomme es einfach nicht hin bzw. ich weiß gar nicht ob es überhaupt möglich ist. Vielleicht kann mir ja hier jemand helfen.. *hoff*
Kurz:
Ich möchte in einer *.xyz-Datei Werte Suchen und Ersetzen. Meine *.xyz-Datei ist wie eine normale Spaltenorientierte TXT aufgebaut.
Nun etwas genauer:
Ich möchte per Makro(?) eine *.xyz-Datei öffnen lassen, und in dieser Datei soll dann ein 3stelliger Wert (15. bis 17. Stelle in jeder Zeile) durchsucht und ersetzt werden. Gesucht werden soll in dem Bereich B2:22 und mit dem Wert aus C2:22 ersetzt und gespeichert werden. Als kleiner Extrabonus wäre es noch interessant wenn in Spalte D2:22 die anzahl der ersetzten Werte stehn würde, aber dies ist kein muss, wenn es zu kompliziert ist.
*.xyz-Datei:
58471654    9 050  585454545
58471655    5 080  575755757
58471670    4 045  575757524
58471679    8 029  575757575
58471789    6 021  695775757
xxx
xxx = 15.-17. Stelle: Der Bereich, der in jeder Datei durchsucht und ersetzt werden soll.
Excel-Datei:
	 B	 C
2	000	000
3	080	099
4	045	005
5	099	090
6	029	008
.	021	008
.	023	098
22	024	098
Spalte B steht der gesuchte wert und daneben in Spalte C steht der zu ersetzende.
Ich stelle mir das eigentlich so vor:
Excel-Datei öffnen, Werte in B2:22 und C2:C22 anpassen, Makro ausführen, Datei auswählen, Bestätigen, fertig ;-))))
Gibt es da eine gescheite Lösung? Das würde mir eine gaaaaanze Menge Arbeit ersparen, weil ich sonst über 100-200 Datein per Hand im Texteditor mit "Suchen/Ersetzen" manuell bearbeiten müsste ;-(
Ich hoffe mir kann hier jemand helfen..
Liebe Grüße,
Manuela
AW: xyz-Datei öffnen und Suchen/Ersetzen
06.05.2011 20:20:19
Josef

Hallo Manuela,
so?
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub SuchenUndErsetzen()
  Dim strFile As String, strTmp As String, strFind As String, strInput
  Dim vntRet As Variant
  Dim FF1 As Integer, FF2 As Integer
  strFile = Application.GetOpenFilename("XYZ Dateien (*.xyz),*.xyz")
  If strFile = CStr(False) Then Exit Sub
  strTmp = Environ("TMP") & "\xyz.tmp"
  With ThisWorkbook.Sheets("Tabelle1")
    FF1 = FreeFile
    
    Open strFile For Input As #FF1
    
    FF2 = FreeFile
    
    Open strTmp For Output As #FF2
    
    Do While Not EOF(FF1)
      Line Input #FF1, strInput
      strFind = Mid(strInput, 15, 3)
      vntRet = Application.Match(strFind, .Columns(2), 0)
      If IsNumeric(vntRet) Then
        strInput = Left(strInput, 14) & .Cells(vntRet, 3).Text & Mid(strInput, 18)
      End If
      Print #FF2, strInput
    Loop
    
    
    Close #FF1
    
    Close #FF2
  End With
  Kill strFile
  Name strTmp As strFile
End Sub



« Gruß Sepp »

Anzeige
AW: xyz-Datei öffnen und Suchen/Ersetzen
06.05.2011 20:52:10
Manuela
Hallo Josef,
erstmal ein dickes Dankeschön für die Hilfe. Ich habe dennoch ein Problem, denn das öffnen und Auswählen der Datei klappt wunderbar, aber die Änderungen werden nicht übernommen. An meiner *.xyz-Datei hat sich nix verändert :-(

Die Datei https://www.herber.de/bbs/user/74694.xls wurde aus Datenschutzgründen gelöscht


https://www.herber.de/bbs/user/74695.txt
Die *.txt ist meine *.xyz (Upload als xyz funktioniert nicht, daher die umbenennung). Ich habe die Datei stark gekürzt. Normalerweise hab ich 100-20000 Datenzeilen.
Hättest Du eine Idee was ich falsch gemacht habe?
Liebe Grüße
Anzeige
AW: xyz-Datei öffnen und Suchen/Ersetzen
06.05.2011 20:59:33
Josef

Hallo Manuela,
in deiner Spalte "B" steht ja auch nicht z. B. "010", sondern 10!
Hab den Code entsprechend angepasst.
https://www.herber.de/bbs/user/74696.xls

« Gruß Sepp »

AW: xyz-Datei öffnen und Suchen/Ersetzen
06.05.2011 21:07:21
Manuela
Josef du bist klasse!
Nun Funktioniert es einwandfrei und Du hast mir eine Menge Arbeit erspart. Könntest du mir vllt. noch einen Tipp geben wie ich am Ende eine Erfolgsmeldung einbaue? "Änderungen übernommen!" oder "373269 Werte geändert!" ?
Gruß
Anzeige
AW: xyz-Datei öffnen und Suchen/Ersetzen
06.05.2011 21:29:45
fcs
Hallo Manuela,
nachdem ich auch an einer Lösung für dich gearbeitet hatte, will ich sie hier auch präsentieren. Ich schätze, das Sepps Lösung bei großen Textdateien wegen der verwendeten Suchfunktion deutlich schneller ist als meine.
Bei mir wird auch noch die Zahl der Ersetzungen in Spalte D ausgegeben.
Gruß
Franz
'Erstellt unter Excel 2007
Sub Ersetzen_in_xyz_Dateien()
Dim arrQuelle(2 To 22) As String, arrZiel(2 To 22) As String, Zeile As Long
Dim FF As Integer, FF1 As Integer, sText As String, sTemp As String
With ActiveSheet
'zu suchende und ersetzende Daten einlesen
For Zeile = LBound(arrQuelle) To UBound(arrQuelle)
arrQuelle(Zeile) = .Cells(Zeile, 2).Text
arrZiel(Zeile) = .Cells(Zeile, 3).Text
Next
End With
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte Textdatei auswählen"
.InitialFileName = "*.xyz"
'Name der temporären
sTemp = VBA.CurDir & Application.PathSeparator & "temp.txt"
Do Until .Show = 0 'Abbrechen des Dialogs beendet Makroausführung
Application.ScreenUpdating = False
'Werte Bereich mit Anzahl der Ersetzungen löschen
Range(Cells(LBound(arrQuelle), 4), Cells(UBound(arrQuelle), 4)).ClearContents
'temporäre Datei für Ausgabe öffnen
FF1 = FreeFile()
Open sTemp For Output As #FF1
'Datendatei für das Einlesen öffnen
FF = FreeFile()
Open .SelectedItems(1) For Input As #FF
'Datendatei Zeilenweise einlesen
Do Until EOF(FF)
Line Input #FF, sText
'Teil-Text (Zeichen 15 bis 17) in Zeile vergleichen und ggf. ersetzen
For Zeile = LBound(arrQuelle) To UBound(arrQuelle)
If Mid(sText, 15, 3) = arrQuelle(Zeile) Then
sText = Left(sText, 14) & arrZiel(Zeile) & Mid(sText, 18)
'Anzahl in Spalte D um 1 erhöhen
Cells(Zeile, 4).Value = Cells(Zeile, 4).Value + 1
Exit For
End If
Next
'Textzeile in temporäre Datei schreiben
Print #FF1, sText
Loop
Close #FF
Close #FF1
'temporäre Datei in Originaldatei kopieren
VBA.FileCopy Source:=sTemp, Destination:=.SelectedItems(1)
Application.ScreenUpdating = True
Loop
'temporäre Datei ggf. löschen
If Dir(sTemp)  "" Then Kill sTemp
End With
End Sub

Anzeige
AW: xyz-Datei öffnen und Suchen/Ersetzen
06.05.2011 22:29:27
Manuela
Hallo Franz, Hallo Josef!
Franz:
Dir auch vielen Dank für die Mühe. Deine Version funktioniert soweit, aber nach der Durchführung geht wieder direkt die Dateiauswahl auf(gewollt?). Meine Tendenz geht daher eher zu der Möglichkeit vom Josef.
Josef:
Deine Variante ist echt klasse! Ich hab mir den Code mal genauer angeschaut und versucht zu verstehen, aber leider sind das für mich alles nur böhmische Wälder :-(. Verstehe ich das richtig, dass in deiner Variante die komplette Spalte B durchsucht wird und durch den Wert daneben in Spalte C ersetzt wird?
Ich hätte noch ein Anliegen zu einer größeren Dateigruppe die auf genau die gleiche Weise, allerdings mit 2 Bereichen "Suchen/Ersetzen" gemacht werden müsste. Könntest Du mir dabei noch mal Helfen wenn ich es genauer hier rein schreibe?
Liebe Grüße
Anzeige
Nur zu! o.T.
06.05.2011 22:37:28
Josef
« Gruß Sepp »

AW: Nur zu! o.T.
06.05.2011 22:59:05
Manuela
Hallo!
Fein, wärest du noch so nett und könntest mir die Frage von eben (zu der Spalte B+C) beantworten? Ich versteh nur Bahnhof und würde es gern aus interesse wissen, falls ich die Spalten später verändern/anpassen möchte.
Ich bräuchte nochmal fast genau das gleiche wie eben, aber diesmal folgendermaßen abgeändert:
Durchsuche *.xyz-Datei an 10. Stelle nach dem Wert aus B2:B10 und änder in C2:10. Jetzt möchte ich noch in dem gleichen Schritt an der 30.-32. Stelle nach dem Wert aus F2:F22 suchen und durch G2:22 ersetzen. Achja, bei der 1. Suche die "Anzahl der Änderungen" in D2:D10 und bei der 2. Suche H2:22.
Ich hoffe Du verstehst mich. Ich Uploade meine Exceldatei nochmal(Arbeitsblatt: Tabelle2).
Danke :-)

Die Datei https://www.herber.de/bbs/user/74697.xls wurde aus Datenschutzgründen gelöscht


Anzeige
AW: Nur zu! o.T.
06.05.2011 23:14:35
Josef

Hallo Manuela,
das bezieht sich aber Textdateien mit einem anderen AUfbau, oder?
Ich habe im Code jetzt den Bereich mit den alten Bezeichnungen angegeben, das lässt sich leichter ändern.
https://www.herber.de/bbs/user/74698.xls

« Gruß Sepp »

Anzeige
AW: Nur zu! o.T.
06.05.2011 23:23:44
Manuela
Hallo Josef,
ja die 2. Variante bezieht sich auf eine andere *.xyz-Datei(!), allerdings mit einem anderen Aufbau. Daher auch die Änderungswünsche an 10. und 30.-32. Stelle. Wenn ich dein Makro ausführe, dann sagt er mir bei beiden Werten 0 geändert.
Gruß
AW: Nur zu! o.T.
06.05.2011 23:35:58
Josef

Hallo Manuela,
hatte zwei Anpassungen vergessen;-))
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub SuchenUndErsetzen2()
  Dim strFile As String, strTmp As String, strFind As String, strInput
  Dim vntRet As Variant
  Dim rng1 As Range, rng2 As Range
  Dim FF1 As Integer, FF2 As Integer
  strFile = Application.GetOpenFilename("XYZ Dateien (*.xyz),*.xyz")
  If strFile = CStr(False) Then Exit Sub
  strTmp = Environ("TMP") & "\xyz.tmp"
  With ThisWorkbook.Sheets("Tabelle2")
    Set rng1 = .Range("B2:B10") '1. Bereich mit den alten Bezeichnungen, die Neuen stehen in der Spalte daneben
    
    Set rng2 = .Range("F2:F22") '2. Bereich mit den alten Bezeichnungen, die Neuen stehen in der Spalte daneben
    
    rng1.Offset(0, 2).ClearContents
    rng2.Offset(0, 2).ClearContents
    
    FF1 = FreeFile
    
    Open strFile For Input As #FF1
    
    FF2 = FreeFile
    
    Open strTmp For Output As #FF2
    
    Do While Not EOF(FF1)
      Line Input #FF1, strInput
      strFind = Mid(strInput, 10, 1)
      vntRet = Application.Match(Clng(strFind), rng1, 0)
      If IsNumeric(vntRet) Then
        strInput = Left(strInput, 9) & rng1.Cells(vntRet, 1).Offset(0, 1).Text & Mid(strInput, 11)
        rng1.Cells(vntRet, 1).Offset(0, 2) = rng1.Cells(vntRet, 1).Offset(0, 2) + 1
      End If
      strFind = Mid(strInput, 30, 3)
      vntRet = Application.Match(Clng(strFind), rng2, 0)
      If IsNumeric(vntRet) Then
        strInput = Left(strInput, 29) & rng2.Cells(vntRet, 1).Offset(0, 1).Text & Mid(strInput, 33)
        rng2.Cells(vntRet, 1).Offset(0, 2) = rng2.Cells(vntRet, 1).Offset(0, 2) + 1
      End If
      Print #FF2, strInput
    Loop
    
    
    Close #FF1
    
    Close #FF2
    
    Kill strFile
    
    Name strTmp As strFile
    
    MsgBox "Es wuden " & Application.Sum(rng1.Offset(0, 2)) & " bei Wert 1" & _
      vbLf & "und " & Application.Sum(rng2.Offset(0, 2)) & _
      " bei Wert 2 geändert!", vbInformation
  End With
  Set rng1 = Nothing
  Set rng2 = Nothing
End Sub



« Gruß Sepp »

Anzeige
AW: Nur zu! o.T.
07.05.2011 10:33:22
Manuela
Hallo Josef,
danke noch mal. Jetzt funktioniert es! Über Nacht *g* sind mir allerdings noch paar Ideen/Fragen durch den Kopf geschossen. Wärest Du vielleicht so nett und könntest mir dabei helfen?
a) Wäre es möglich bei der Dateiauswahl in Tabellenblatt1+2 eine 2. Dateiendung bzw. als 3. Möglichkeit "Alle Dateien" auszuwählen? Falls dies zu kompliziert ist, wäre es egal. Ich könnte zur Not die ganzen Dateien (*.xxx) in *.xyz umbenennen und dann per Marko verändern.
b) Könntest du in dem Code eine Zelle definieren (z.B. B25) wo ich den Dateinamen von der geänderten Datei ausgeben könnte? In etwa so: Zuletzt geänderte Datei: test123456.xyz
Nun, hätte ich nur noch eine letzte Frage:
Wenn ich nicht die Stelle 10 in der *.xyz-Datei ändern möchte, sondern die Stelle 15, dann müsste ich nur "strFind = Mid(strInput, 10, 1)" verändern, oder muss das noch an anderer Stelle gemacht werden?
Ich hänge meine neue Datei als Anlage bei.

Die Datei https://www.herber.de/bbs/user/74700.xls wurde aus Datenschutzgründen gelöscht


Liebe Grüße
Anzeige
AW: Nur zu! o.T.
07.05.2011 10:59:29
Josef

Hallo Manuela,
kein Problem.
Im Dateiauswahldialog sind letzt zwei Dateitypen oder Alle-dateien auswählbar.
In B25 wird die zuletz bearbeitete Datei angezeigt.
Um die Position des zu ersetztenden Begriffes zu ändern ist mehr nötig als nur eine Zahl zu verändern
Im Code sind jetzt Konstanten definiert mit denen du das bequem steuern kannst.
https://www.herber.de/bbs/user/74701.xls

« Gruß Sepp »

AW: Nur zu! o.T.
07.05.2011 21:47:10
Manuela
Vielen Dank! Jetzt funktioniert alles :-)
AW: Nur zu! o.T.
09.05.2011 20:55:15
Manuela
Hallo Josef,
könntest du mir bitte noch mal behilflich sein ? Ich habe festgestellt, dass es sinnvoller wäre wenn man eine Backupdatei anlegen könnte.
Daher meine Frage: Wäre es möglich in beiden Tabellenblättern die alte Datei (*.xyz, *.xxx, *.*) in z.B. [Dateiname].[alte Dateiendung].ALT oder [Dateiname]-ALT.[alte Dateiendung] umzubenennen? Bei der neuen Datei wäre es gut wenn der aktuelle Name beibehalten wird.
Falls du eine Idee hast wie sowas funktionieren könnte, würde ich mich sehr freuen wenn du es mir anpassen könntest. Ich hoffe, dass ich dir damit nicht zuviele Umstände mache :-)
Liebe Grüße
AW: Nur zu! o.T.
10.05.2011 19:21:00
Josef

Hallo Manuela,
hier die angepassten Codes.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub SuchenUndErsetzen()
  Dim strFile As String, strTmp As String, strFind As String, strInput
  Dim vntRet As Variant
  Dim rng As Range
  Const sngReplaceFrom As Single = 15 'Position des Suchbegriffes
  Const sngReplaceLen As Single = 3 'Länge des Suchbegriffes
  Dim FF1 As Integer, FF2 As Integer
  strFile = Application.GetOpenFilename("XYZ Dateien (*.xyz),*.xyz,XXX Dateien (*.xxx), *.xxx,Alle Dateien (*.*),*.*")
  If strFile = CStr(False) Then Exit Sub
  strTmp = Environ("TMP") & "\xyz.tmp"
  With ThisWorkbook.Sheets("Tabelle1")
    Set rng = .Range("B2:B22") 'Bereich mit den alten Bezeichnungen, die Neuen stehen in der Spalte daneben
    
    rng.Offset(0, 2).ClearContents
    
    FF1 = FreeFile
    
    Open strFile For Input As #FF1
    
    FF2 = FreeFile
    
    Open strTmp For Output As #FF2
    
    Do While Not EOF(FF1)
      Line Input #FF1, strInput
      strFind = Mid(strInput, sngReplaceFrom, sngReplaceLen)
      vntRet = Application.Match(Clng(strFind), rng, 0)
      If IsNumeric(vntRet) Then
        strInput = Left(strInput, sngReplaceFrom - 1) & rng.Cells(vntRet, 1).Offset(0, 1).Text & Mid(strInput, sngReplaceFrom + sngReplaceLen)
        rng.Cells(vntRet, 1).Offset(0, 2) = rng.Cells(vntRet, 1).Offset(0, 2) + 1
      End If
      Print #FF2, strInput
    Loop
    
    
    Close #FF1
    
    Close #FF2
    
    If Dir(strFile & ".alt", vbNormal) <> "" Then Kill strFile & ".alt"
    
    Name strFile As strFile & ".alt" 'Backup
    
    Name strTmp As strFile
    .Range("B25") = strFile
    MsgBox "Es wuden " & Application.Sum(rng.Offset(0, 2)) & " Werte geändert!", vbInformation
  End With
  Set rng = Nothing
End Sub

' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub SuchenUndErsetzen2()
  Dim strFile As String, strTmp As String, strFind As String, strInput
  Dim vntRet As Variant
  Dim rng1 As Range, rng2 As Range
  Dim FF1 As Integer, FF2 As Integer
  
  Const sngReplaceFrom1 As Single = 10 'Position des 1. Suchbegriffes
  Const sngReplaceLen1 As Single = 1 'Länge des 1. Suchbegriffes
  Const sngReplaceFrom2 As Single = 30 'Position des 2. Suchbegriffes
  Const sngReplaceLen2 As Single = 3 'Länge des 2. Suchbegriffes
  
  strFile = Application.GetOpenFilename("XYZ Dateien (*.xyz),*.xyz,XXX Dateien (*.xxx), *.xxx,Alle Dateien (*.*),*.*")
  If strFile = CStr(False) Then Exit Sub
  strTmp = Environ("TMP") & "\xyz.tmp"
  With ThisWorkbook.Sheets("Tabelle2")
    Set rng1 = .Range("B2:B10") '1. Bereich mit den alten Bezeichnungen, die Neuen stehen in der Spalte daneben
    
    Set rng2 = .Range("F2:F22") '2. Bereich mit den alten Bezeichnungen, die Neuen stehen in der Spalte daneben
    
    rng1.Offset(0, 2).ClearContents
    rng2.Offset(0, 2).ClearContents
    
    FF1 = FreeFile
    
    Open strFile For Input As #FF1
    
    FF2 = FreeFile
    
    Open strTmp For Output As #FF2
    
    Do While Not EOF(FF1)
      Line Input #FF1, strInput
      strFind = Mid(strInput, sngReplaceFrom1, sngReplaceLen1)
      vntRet = Application.Match(Clng(strFind), rng1, 0)
      If IsNumeric(vntRet) Then
        strInput = Left(strInput, sngReplaceFrom1 - 1) & rng1.Cells(vntRet, 1).Offset(0, 1).Text & Mid(strInput, sngReplaceFrom1 + sngReplaceLen1)
        rng1.Cells(vntRet, 1).Offset(0, 2) = rng1.Cells(vntRet, 1).Offset(0, 2) + 1
      End If
      strFind = Mid(strInput, sngReplaceFrom2, sngReplaceLen2)
      vntRet = Application.Match(Clng(strFind), rng2, 0)
      If IsNumeric(vntRet) Then
        strInput = Left(strInput, sngReplaceFrom2 - 1) & rng2.Cells(vntRet, 1).Offset(0, 1).Text & Mid(strInput, sngReplaceFrom2 + sngReplaceLen2)
        rng2.Cells(vntRet, 1).Offset(0, 2) = rng2.Cells(vntRet, 1).Offset(0, 2) + 1
      End If
      Print #FF2, strInput
    Loop
    
    
    Close #FF1
    
    Close #FF2
    
    If Dir(strFile & ".alt", vbNormal) <> "" Then Kill strFile & ".alt"
    
    Name strFile As strFile & ".alt" 'Backup
    
    Name strTmp As strFile
    
    .Range("B25") = strFile
    MsgBox "Es wuden " & Application.Sum(rng1.Offset(0, 2)) & " bei Wert 1" & _
      vbLf & "und " & Application.Sum(rng2.Offset(0, 2)) & _
      " bei Wert 2 geändert!", vbInformation
  End With
  Set rng1 = Nothing
  Set rng2 = Nothing
End Sub



« Gruß Sepp »

AW: Nur zu! o.T.
10.05.2011 19:57:42
Manuela
Hallo Josef,
danke erstmal. Dein 1. Code funktioniert wunderbar, aber beim 2. bekomme ich jetzt immer einen Laufzeitfehler "13" Typen unverträglich.
Der Debugger springt dann zu dieser Zeile:
vntRet = Application.Match(CLng(strFind), rng2, 0)
Hast ne Idee was der Fehler sein könnte?
Gruß
AW: Nur zu! o.T.
10.05.2011 20:09:11
Manuela
Hallo nochmal,
ich bin nur zu doof. Sorry ;-) hab den Fehler gefunden.
Const sngReplaceFrom2 As Single = 30 'Position des 2. Suchbegriffes
Habe ich vergessen auf
Const sngReplaceFrom2 As Single = 59 'Position des 2. Suchbegriffes
zu ändern....
Jetzt läuft es. Danke!!
Lieben Gruß
AW: xyz-Datei öffnen und Suchen/Ersetzen
07.05.2011 08:23:44
fcs
Hallo Manuela,
Deine Version funktioniert soweit, aber nach der Durchführung geht wieder direkt die Dateiauswahl auf(gewollt?).
Das hatte absichtlich so gemacht, wenn mehrere Textdateien mit den gleichen Änderungen abgearbeitet werden sollen, dann muss man das Makro nicht für jede Datei neu starten, sondern kann sofort die nächste Datei auswählen.
Man kann die Do-Loop-Schleife natürlich auch weglasen und den Abbruch der Dateiauswahl mit
    If .Show = 0 Then Exit Sub ' Abbrechen des Dialogs beendet Makroausführung
prüfen.
Gruß
Franz
AW: xyz-Datei öffnen und Suchen/Ersetzen
06.05.2011 21:33:05
Josef

Hallo Manulela,
sorry, das mit der Spalte "D" hab ich vergessen;-))
Nimm diesen Code (gehört ins Modul1, nicht unter "DieseArbeitsmappe"!).
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub SuchenUndErsetzen()
  Dim strFile As String, strTmp As String, strFind As String, strInput
  Dim vntRet As Variant
  Dim FF1 As Integer, FF2 As Integer
  strFile = Application.GetOpenFilename("XYZ Dateien (*.xyz),*.xyz")
  If strFile = CStr(False) Then Exit Sub
  strTmp = Environ("TMP") & "\xyz.tmp"
  With ThisWorkbook.Sheets("Tabelle1")
    .Range("D2:D" & .Rows.Count).ClearContents
    FF1 = FreeFile
    
    Open strFile For Input As #FF1
    
    FF2 = FreeFile
    
    Open strTmp For Output As #FF2
    
    Do While Not EOF(FF1)
      Line Input #FF1, strInput
      strFind = Mid(strInput, 15, 3)
      vntRet = Application.Match(Clng(strFind), .Columns(2), 0)
      If IsNumeric(vntRet) Then
        strInput = Left(strInput, 14) & .Cells(vntRet, 3).Text & Mid(strInput, 18)
        .Cells(vntRet, 4) = .Cells(vntRet, 4) + 1
      End If
      Print #FF2, strInput
    Loop
    
    
    Close #FF1
    
    Close #FF2
    
    Kill strFile
    
    Name strTmp As strFile
    
    MsgBox "Es wuden " & Application.Sum(.Columns(4)) & " Werte geändert!", vbInformation
  End With
End Sub



« Gruß Sepp »

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige