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

Dateien im Ordner öffnen, x suchen, Zeile in Blatt kopieren

Frage Entwicklung VB for Applications

Mitglied: Firewalker

Firewalker (Level 1) - Jetzt verbinden

20.08.2013, aktualisiert 19:22 Uhr, 1895 Aufrufe, 3 Kommentare

Hallo Zusammen, habe versucht dieses Script ein wenig anzupassen. Leider scheinen meine Vba Kenntnisse noch nicht ganz auszureichen.
('bis hier hin ok) läuft der Code richtig durch wenn die End if und Next richtig gesetzt wären. Diese sind durch viel hin und her versuchen auch durcheinander geraden.
Wäre toll wenn ihr mir helfen könnt.

01.
Sub Zusammenfassen2() 
02.
 
03.
Dim i As Long 
04.
 
05.
'' Testpath 
06.
Const sSourcePath = "c:\test\" 'Ordner der Auswertedateien - bitte anpassen 
07.
Set wbGes = ActiveWorkbook 'aktuelle Mappe und ... 
08.
Set wsZiel = ActiveWorkbook.ActiveSheet '... aktuelle Tabelle zwischenspeichern 
09.
Set fso = CreateObject("Scripting.FileSystemObject") 
10.
Z = 2 'ab Zeile 2 in der Sammeltabelle eintragen 
11.
sNamen = "#" 'Variable zum Sammeln der Namen vorbelegen 
12.
Application.ScreenUpdating = False 'während der folgenden Aktionen Excel-Bildschirm "einfrieren"; diese Zeile kann auch auskommentiert / entfernt werden 
13.
For Each oFile In fso.GetFolder(sSourcePath).Files 'alle Dateien des Auswerteordners durchgehen 
14.
If LCase(fso.GetExtensionName(oFile.Name)) = "xls" Then 'nur .xls-Dateien bearbeiten; falls "xlsx" bitte anpassen; nur Kleinbuchstaben verwenden 
15.
     
16.
    Set wbQuellDatei = Application.Workbooks.Open(oFile.Path) 'Auswerttedatei öffnen 
17.
    With ActiveWorkbook.Worksheets(1) 'Daten aus der ersten Tabelle der Auswertedatei entnehmen 
18.
    ZielZeile = Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile ermitteln 
19.
    For i = 9 To ZielZeile ' Bereich von 9 bis letzte Zeile 
20.
     If .Cells(i, 15) = "X" Then ' Wenn O zeile = x dann 
21.
          MsgBox " Gefunden" ' nur als test hier !!! 
22.
             
23.
         Wert = Rows(i).Copy     ' bis hier hin OK 
24.
 
25.
            wsZiel.Cells(Z, i).Paste    '... einfügen ( falscher Befehl für eine Row ? ) 
26.
         
27.
End If    'falsch platziert? 
28.
Next      ' falsch plaziert ? 
29.
              Z = Z + 1 'Zeilennummer der Zieltabelle für das nächste Einfügen erhöhen 
30.
              
31.
End If #ggf. 'auch falsch platziert ? 
32.
Next ' falsch platziert ?  
33.
 
34.
        wbQuellDatei.Close 'Datei schließen 
35.
   
36.
    
37.
 
38.
End With 
39.
 
40.
Application.ScreenUpdating = True 'Excel-Bildschirmanzeige wieder "auftauen" ;-) 
41.
wsZiel.Activate 'zur Sicherheit Zieltabelle aktivieren 
42.
wbGes.Save 'Sammeldatei speichern 
43.
MsgBox "Fertig." 
44.
End If 
45.
 
46.
 
47.
End Sub
Mitglied: bastla
20.08.2013 um 19:27 Uhr
Hallo Firewalker!

End With sollte nicht in Zeile 38, sondern in Zeile 30 stehen - wenn Du konsequent alle Blöcke (hier: For, If und With) einrückst, ist das leichter zu erkennen ...
Bitte warten ..
Mitglied: Firewalker
20.08.2013, aktualisiert um 19:54 Uhr
Hallo bastla.
Ok habe es so verschoben und Zeile 44 Enf if raus genommen. Jetzt läuft das Script schon mal wieder an.
Jetzt kommt der Fehler in Zeile 25. sobald ein X gefunden wurde.
Was soll er tun: Bein finden von X in Spalte O die gesammte Zeile kopieren ( alternativ wäre auch a-o möglich) und in wsZiel kopieren. Liegt es dort am i ?
Und warum ist Wert definert, den rufe ich doch gar nicht wieder auf ?
Bitte warten ..
Mitglied: Firewalker
20.08.2013 um 21:25 Uhr
Habe es glaube ich hinbekommen.
01.
Sub Zusammenfassen2() 
02.
ActiveWorkbook.Worksheets(1).Range("A2:O30000").ClearContents 
03.
Dim i As Long 
04.
 
05.
'' Testpath 
06.
Const sSourcePath = "c:\test\" 'Ordner der Auaswertedateien - bitte anpassen 
07.
Set wbGes = ActiveWorkbook 'aktuelle Mappe und ... 
08.
Set wsziel = ActiveWorkbook.ActiveSheet '... aktuelle Tabelle zwischenspeichern 
09.
Set fso = CreateObject("Scripting.FileSystemObject") 
10.
Z = 2 'ab Zeile 2 in der Sammeltabelle eintragen 
11.
sNamen = "#" 'Variable zum Sammeln der Namen vorbelegen 
12.
Application.ScreenUpdating = False 'während der folgenden Aktionen Excel-Bildschirm "einfrieren"; diese Zeile kann auch auskommentiert / entfernt werden 
13.
    For Each oFile In fso.GetFolder(sSourcePath).Files 'alle Dateien des Auswerteordners durchgehen 
14.
        If LCase(fso.GetExtensionName(oFile.Name)) = "xls" Then 'nur .xls-Dateien bearbeiten; falls "xlsx" bitte anpassen; nur Kleinbuchstaben verwenden 
15.
        Set wbQuellDatei = Application.Workbooks.Open(oFile.Path) 'Auswerttedatei öffnen 
16.
             With ActiveWorkbook.Worksheets(1) 'Daten aus der ersten Tabelle der Auswertedatei entnehmen 
17.
             ZielZeile = Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile ermitteln 
18.
                    For i = 9 To ZielZeile ' Bereich von 9 bis letzte Zeile 
19.
                             If .Cells(i, 15) = "X" Then ' Wenn O zeile = x dann 
20.
                                      
21.
       
22.
         wert = Rows(i).Copy ' bis hier hin OK 
23.
             wsziel.Rows(Z).PasteSpecial   '... einfügen 
24.
          Z = Z + 1 'Zeilennummer der Zieltabelle für das nächste Einfügen erhöhen 
25.
                  End If 
26.
                    Next 
27.
               
28.
            End With 
29.
        End If 
30.
    Next 
31.
     
32.
  wbQuellDatei.Close 'Datei schließen 
33.
 
34.
Application.ScreenUpdating = True 'Excel-Bildschirmanzeige wieder "auftauen" ;-) 
35.
wsziel.Activate 'zur Sicherheit Zieltabelle aktivieren 
36.
wbGes.Save 'Sammeldatei speichern 
37.
MsgBox "Fertig." 
38.
 
39.
End Sub
Bitte warten ..
Ähnliche Inhalte
Microsoft
Im ordner nach dateien aus excel liste suchen (2)

Frage von tioloco zum Thema Microsoft ...

Batch & Shell
gelöst Dateien aus einer Liste anhand verschiedener Parameter kopieren (6)

Frage von gnumpf21 zum Thema Batch & Shell ...

Batch & Shell
gelöst Nach bestimmten Ordner namen suchen und in einem anderem Pfad kopieren (8)

Frage von erdgnrft zum Thema Batch & Shell ...

C und C++
Dateien in Ordner kopieren anhand vom Teil eines Dateinamen (22)

Frage von onlyforu8373 zum Thema C und C ...

Neue Wissensbeiträge
Sicherheits-Tools

Sicherheitstest von Passwörtern für ganze DB-Tabellen

(1)

Tipp von gdconsult zum Thema Sicherheits-Tools ...

Peripheriegeräte

Was beachten bei der Wahl einer USV Anlage im Serverschrank

(9)

Tipp von zetboxit zum Thema Peripheriegeräte ...

Windows 10

Das Windows 10 Creators Update ist auf dem Weg

(6)

Anleitung von BassFishFox zum Thema Windows 10 ...

Heiß diskutierte Inhalte
Batch & Shell
gelöst ZIP-Archive nach Dateien durchsuchen und Pfade ausgeben (33)

Frage von evinben zum Thema Batch & Shell ...

Router & Routing
Routingproblem in Homerouter-Kaskade mit Raspi (19)

Frage von Oldschool zum Thema Router & Routing ...

Server
Freenas schlechte Schreib Performance bei NFS (16)

Frage von janosch12 zum Thema Server ...

Windows Server
Fehler Vertrauensstellung im AD (14)

Frage von thomas-99 zum Thema Windows Server ...