Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon m.eng.86 vom 14.04.2022, 11:03 Options

getopenfilename probleme

hallo zusammen,

bin eher ein anfänger was excel vba betrifft, dennoch muss ich hier jetz mal ein makro machen und benötige eure hilfe. mal kurz eine beschreibung was ich brauche:
eine bestehende Exceldatei soll mit PICS-Regeldateien gefüttert werden. das aufgezeichnete makro unten verarbeitet zwei testdateien "1" und "2" so wie ich es brauche..mein problem ist nun dass die dateien eigtl immer anders heißen und unterschiedlich viele sind. mit der funktion getopenfilename würde ich am liebsten manuell die dateien auswählen und das makro macht dann weiter wie gewünscht. allerdings muss es ja dann wissen wie die dateien heissen die ich ausgewählt habe?!?! naja, ich komm nicht weiter, wäre nett wenn jemand von euch einen vorschlag hat für mich!

gruß harry

Sub Makro2()
'
' Makro2 Makro
' files 2
'

'
ChDir "C:\Users\Harry\Desktop\test"
Workbooks.OpenText Filename:="C:\Users\Harry\Desktop\test\2.prf", Origin:= _
xlMSDOS, StartRow:=6, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True
Workbooks.OpenText Filename:="C:\Users\Harry\Desktop\test\1.prf", Origin:= _
xlMSDOS, StartRow:=6, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True
Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Spek_Vergleich.xls").Activate
Range("A5").Select
ActiveSheet.Paste
Windows("2.prf").Activate
Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Spek_Vergleich.xls").Activate
Range("D5").Select
ActiveSheet.Paste
Columns("G:R").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("N6").Select
ActiveWindow.SmallScroll ToRight:=-4
End Sub

Antwort schreiben

Antwort 1 von malSchauen vom 14.04.2022, 23:10 Options

Hi,

Sowas würde bei mir z.B. in etwa aussehen wie folgt:

Sub naLos()
Dim varFileNames As Variant
Dim lngCount As Long

varFileNames = Application _
    .GetOpenFilename("PICS-Regeldateien (*.prf), *.prf", 1, "Datei wählen", , True)     'Filenamen holen
If VarType(varFileNames) = vbBoolean Then                                               'bei Abbruch
    MsgBox "Keine Datei gewählt!"                                                       'kleine Meldung
    Exit Sub                                                                            'Makro Ende
End If

'ggf. hier gesamten Zielbereich löschen
For lngCount = LBound(varFileNames) To UBound(varFileNames) Step 1                      'vom ersten bis zum letzten File
    MsgBox ("File " & varFileNames(lngCount) & " wird verarbeitet")                     'Meldung hier nur als Beispielcode
    '===========
    'PSEUDOCODE
    '===========
    'EinfügeZielRange ermitteln (1.=A5, 2.=D5, 3.=G5, ...?)
    'File öffnen (Workbooks.OpenText Filename:=varfilenames(lngCount), Origin:= ...)
    'Range kopieren
    'in ZielRange einfügen
    'CutCopyMode=false
    'geöffnetes File Schliessen
Next lngCount                                                                           'nächstes File der Auswahl
End Sub

Evtl. kannst Du damit weiterarbeiten. So Du damit nicht ans Ziel kommst, kannst Du Deine beiden BeispielDateien ja mal zur Ansicht ins Netz stellen. (z.B. hier (Downloadlink dann hier posten)).

bye
malSchauen

Antwort 2 von m.eng.86 vom 15.04.2022, 09:04 Options

hi,

danke dir schonmal! ich habe die beiden dateien mal hochgeladen...

http://www.file-upload.net/download-2435983/1.prf.html
http://www.file-upload.net/download-2435984/2.prf.html

wenn sie mit excel geöffnet werden sollen, beginnend in zeile 6 und trennzeichen sind tabstopp und komma.
vielleicht könntest du mir den code zum weiterverarbeiten noch in dein makro einfügen, dann wäre mir sehr geholfen!

vielen dank und freundliche grüße
harry

Antwort 3 von malSchauen vom 15.04.2022, 21:58 Options

Hi,

Die Vervollständigung des Codes hatte ich mir in etwa vorgestellt, wie folgt:

Sub naLos()
Dim varFileNames As Variant
Dim lngCount As Long
Dim wksZiel As Worksheet
Dim wbkQuelle As Workbook
Dim lngZielSpalte As Long

varFileNames = Application _
    .GetOpenFilename("PICS-Regeldateien (*.prf), *.prf", 1, "Datei wählen", , True)     'Filenamen holen
If VarType(varFileNames) = vbBoolean Then                                               'bei Abbruch
    MsgBox "Keine Datei gewählt!"                                                       'kleine Meldung
    Exit Sub                                                                            'Makro Ende
End If

Application.ScreenUpdating = False                                                      'Bildschirmaktualisierung aus

Set wksZiel = ThisWorkbook.Worksheets("Tabelle1")                                       'ZielTabelle !anpassen! und "merken"
'ggf. hier gesamten Zielbereich löschen
With wksZiel
    .Range(.Range("A5"), .Range("A5").SpecialCells(xlCellTypeLastCell)).ClearContents
End With

For lngCount = LBound(varFileNames) To UBound(varFileNames) Step 1                      'vom ersten bis zum letzten File
'    MsgBox ("File " & varFileNames(lngCount) & " wird verarbeitet")                     'Meldung hier nur als Beispielcode
    '===========
    'PSEUDOCODE
    '===========
    'EinfügeZielRange ermitteln (1.=A5, 2.=D5, 3.=G5, ...?)
    lngZielSpalte = lngCount + (lngCount - 1) * 2
    'File öffnen (Workbooks.OpenText Filename:=varfilenames(lngCount), Origin:= ...)
    Workbooks.OpenText Filename:=varFileNames(lngCount), StartRow:=6, Tab:=True, Comma:=True
    Set wbkQuelle = ActiveWorkbook
    'Range kopieren
    wbkQuelle.ActiveSheet.Range("A1").CurrentRegion.Copy
    'in ZielRange einfügen
    wksZiel.Cells(5, lngZielSpalte).Value = wbkQuelle.Name
    wksZiel.Cells(6, lngZielSpalte).PasteSpecial Paste:=xlAll
    Application.CutCopyMode = False
    'geöffnetes File Schliessen
    wbkQuelle.Close
Next lngCount                                                                           'nächstes File der Auswahl

Application.ScreenUpdating = True                                                       'Bildschirmaktualisierung ein
wksZiel.Range("A5").Select

Set wksZiel = Nothing
Set wbkQuelle = Nothing
End Sub

bye
malSchauen

Antwort 4 von m.eng.86 vom 18.04.2022, 12:29 Options

hi,

danke schonmal. jedoch bekomme ich eine fehlermeldung "laufzeitfehler 1004:die select mehtode des range objekts kann nicht ausgeführt werden"
nach debuggen: => wksZiel.Range("A5").Select

gruß harry

Antwort 5 von malSchauen vom 18.04.2022, 14:18 Options

Hi,

Ändere das Ende des Subs einmal wie folgt:


.
.
.
Application.ScreenUpdating = True                                                       'Bildschirmaktualisierung ein
ThisWorkbook.Activate
wksZiel.Select
wksZiel.Range("A5").Select

Set wksZiel = Nothing
Set wbkQuelle = Nothing
End Sub

Dann solte dieser Fehler eigtl. nicht mehr auftreten können.

bye
malSchauen

Antwort 6 von m.eng.86 vom 18.04.2022, 16:46 Options

sieht sehr gut aus!

vielen dank!

Antwort 7 von m.eng.86 vom 19.04.2022, 09:44 Options

hi,

jetzt stellt sich mir doch noch eine frage:

durch das makro werden zelleninhalte in den spalten c, f, i, etc gelöscht.
wie kann ich das verändern? in diesen spalten darf nichts gelöscht werden...es sollen wirklich nur jeweils 2spalten eingefügt werden aus den geldenen dateien.

gruß harry

Antwort 8 von m.eng.86 vom 19.04.2022, 10:27 Options

fehler gefunden^^

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..