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, 3267 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
Ähnliche Inhalte
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 ...

Neue Wissensbeiträge
Tipps & Tricks

Wie Hackt man sich am besten in ein Computernetzwerk ein

(29)

Erfahrungsbericht von Herbrich19 zum Thema Tipps & Tricks ...

Humor (lol)

Bester Vorschlag eines Supporttechnikers ever: APC

(15)

Erfahrungsbericht von DerWoWusste zum Thema Humor (lol) ...

Windows Server

Exchange 2010 Active Directory und Windows Server 2016

(4)

Erfahrungsbericht von Herbrich19 zum Thema Windows Server ...

Heiß diskutierte Inhalte
Internet
gelöst Mitarbeiter surft auf unerwünschter Seite - Wie damit umgehen? (49)

Frage von sabines zum Thema Internet ...

LAN, WAN, Wireless
gelöst Eintägige Netzwerkunterbrechung trotz Backupleitung (15)

Frage von iAmbricksta zum Thema LAN, WAN, Wireless ...

Router & Routing
PFsense - Netzverbindung steht, aber kein Internet vorhanden (14)

Frage von aschmid zum Thema Router & Routing ...

Windows Server
Server 2012 R2 - Zugriff Verweigert bei jeglicher Tätigkeit (13)

Frage von DarkLevi zum Thema Windows Server ...