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

Excel-Makro Dateien und Tabellenblätter durchsuchen und Werte in neue Excel Datei auslesen

Frage Microsoft Microsoft Office

Mitglied: vzimmer

vzimmer (Level 1) - Jetzt verbinden

10.10.2011 um 16:16 Uhr, 3257 Aufrufe

Hallo,

ich würde gerne ein ähnliches Makro wie in http://www.administrator.de/index.php?content=43626#703976 verwenden, bekomme aber die Anpassung für meine Zwecke nicht hin.

Ich habe mehrere Dateien mit jeweils mehreren Tabellenblättern, die ausgelesen werden sollen und deren Daten in eine Zieldatei übertragen werden sollen.

Das ganze soll mit einem Suchbegriff geschehen, aber je nach Suchbegriff sollen in Relation zum Suchbegriff unterschiedliche Zellen ausgelesen werden.

Bsp. Suchbegriff Name => +1 Spalte rechts soll ausgegeben werden
Bsp. Suchbegriff Auszahlunt Monatsprämie 1 => +1 Zeile darunter soll ausgegeben werden
Bsp. Suchbegriff Zielerreichung MP 1 => + 1 Spalte rechts soll ausggegeben werden
Bsp. Suchbegriff Jan 11 => + Spalte 1-7 rechts davon sollen ausgegeben werden

D.h. ich muss irgendwie für jeden Suchbegriff definieren können, welcher Wert ausgegeben werden soll, dieser soll dann in der Zieldatei jeweils in die Spalte daneben geschrieben werden und die Daten aus dem nächsten Tabellenblatt in einer neuen Zeile etc.

Ich kenn mich mit Makros nicht so gut aus, ein paar kleinere Anpassungen hab ich zwar geschafft, aber jetzt häng ich.
Anbei mein (fehlerhafter) Versuch:

01.
Sub GetData() 
02.
 
03.
Dim oMe As Object, sBereich As String, iZeile As Integer, iSpalte As Integer, sKennz As String 
04.
Dim i As Integer, sWbName As String, rFound As Range 
05.
Dim vName As Variant, vVorname As Variant, vBU As Variant, vAbteilung As Variant, vMPK1 As Variant, vMPK2 As Variant, vMPK3 As Variant 
06.
Dim oFS As Object, oDatei As Object, wsTabelle As Worksheet, bEintrag As Boolean 
07.
 
08.
Set oMe = ThisWorkbook.Worksheets("Tabelle1") 'Zieltabelle (in der gerade geöffneten Datei) 
09.
 
10.
iZeile = 4 'ab dieser Zeile Ergebnisse in die Zieltabelle eintragen 
11.
iSpalte = 1 
12.
 
13.
Const sDateiPfad As String = "H:\Eigene Dateien\Dateienauslesen\" 'Pfad für zu durchsuchende Excel-Dateien; mit Backslash am Ende 
14.
Const iSbAnzahl = 7 'Nach x Begriffen suchen 
15.
Dim sSuchbegriff(iSbAnzahl) As String 
16.
sSuchbegriff(1) = "Name:" 
17.
sSuchbegriff(2) = "Vorname:" 
18.
sSuchbegriff(3) = "BU:" 
19.
sSuchbegriff(4) = "Abteilung:" 
20.
sSuchbegriff(5) = "Auszahlung Monatspraemie 1" 
21.
sSuchbegriff(6) = "Auszahlung Monatspraemie 2" 
22.
sSuchbegriff(7) = "Auszahlung Monatspraemie 3" 
23.
sBereich = "A1:Z200" 
24.
 
25.
Set oFS = CreateObject("Scripting.FileSystemObject") 
26.
For Each oDatei In oFS.GetFolder(sDateiPfad).Files 
27.
    sWbName = oDatei.Name 
28.
    Workbooks.Open (oDatei.Path), Password:="pw", WriteResPassword:="pw" 
29.
    For Each wsTabelle In Workbooks(sWbName).Worksheets() 
30.
            For i = 0 To iSbAnzahl 
31.
                Set rFound = wsTabelle.Range(sBereich).Find(sSuchbegriff(i), LookIn:=xlValues) 
32.
                If Not rFound Is Nothing Then 
33.
                    vWert = wsTabelle.Cells(rFound.Row, rFound.Column + 1).Value 
34.
                    vVorname = wsTabelle.Cells(rFound.Row, rFound.Column + 1).Value 
35.
                    vBU = wsTabelle.Cells(rFound.Row, rFound.Column + 1).Value 
36.
                    vAbteilung = wsTabelle.Cells(rFound.Row, rFound.Column + 1).Value 
37.
                    vMPK1 = wsTabelle.Cells(rFound.Row + 1, rFound.Column).Value 
38.
                    vMPK2 = wsTabelle.Cells(rFound.Row + 1, rFound.Column).Value 
39.
                    vMPK3 = wsTabelle.Cells(rFound.Row + 1, rFound.Column).Value 
40.
                    With oMe 
41.
                    .Cells(iZeile, i + 1).Value = vName 
42.
                    .Cells(iZeile, i + 2).Value = vVorname 
43.
                    .Cells(iZeile, i + 3).Value = vBU 
44.
                    .Cells(iZeile, i + 4).Value = vAbteilung 
45.
                    .Cells(iZeile, i + 5).Value = vMPK1 
46.
                    .Cells(iZeile, i + 6).Value = vMPK2 
47.
                    .Cells(iZeile, i + 7).Value = vMPK3 
48.
                    bEintrag = True 
49.
                    End With 
50.
                End If 
51.
            Next 
52.
            If bEintrag Then iZeile = iZeile + 1 'mindestens ein Eintrag erfolgt, daher neue Zeile 
53.
    Next 
54.
    Workbooks(sWbName).Saved = True 
55.
    Workbooks(sWbName).Close 
56.
Next 
57.
End Sub
Danke für Eure Hilfe!

Vicky
Neuester Wissensbeitrag
Off Topic

"Ich habe nichts zu verbergen"

(2)

Erfahrungsbericht von FA-jka zum Thema Off Topic ...

Ähnliche Inhalte
Microsoft Office
Excel Dateien durchsuchen und Werte einzeln in neue Excel Datei auslesen (1)

Frage von krischanii zum Thema Microsoft Office ...

VB for Applications
gelöst VB Skript Excel Datei (3)

Frage von Frager zum Thema VB for Applications ...

Microsoft Office
gelöst Excel Datei bleibt unbearbeitet trotz täglichem Zugriff (61)

Frage von Edaseins zum Thema Microsoft Office ...

Heiß diskutierte Inhalte
CPU, RAM, Mainboards
Kaufberatung für mind. 8 verschiedene HighEnd-Mainboards (23)

Frage von yperiu zum Thema CPU, RAM, Mainboards ...

Mac OS X
Mac kann nicht im LAN pingen alle anderen schon (19)

Frage von smartino zum Thema Mac OS X ...

Hardware
gelöst PCI-Express-Adapterfrage (14)

Frage von DerWoWusste zum Thema Hardware ...

Linux Netzwerk
DHCP IP-vergabe erst nach 1-2 Minuten (11)

Frage von Maik82 zum Thema Linux Netzwerk ...