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, 1885 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 ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(1)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Batch & Shell
Parsen mehrer Dateien und Ausgabe je einer Zeile (1)

Frage von grka zum Thema Batch & Shell ...

Batch & Shell
gelöst Datei in Ordner mit Batchdatei suchen und weiterverarbeiten (2)

Frage von MichaelWiggen zum Thema Batch & Shell ...

Windows Server
gelöst Datei per Batch in Ordner mit sich ständig änderndem Namen kopieren (3)

Frage von Drxrey zum Thema Windows Server ...

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

Frage von onlyforu8373 zum Thema C und C ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Outlook & Mail
Outlook 2010 findet ost datei nicht (18)

Frage von Floh21 zum Thema Outlook & Mail ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...