Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen (A bis Z)

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, 3281 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
Excel: Makro soll mehrer Dateien auslesen und in einer neuen Datei zusammenfassen (12)

Frage von Michelle1995 zum Thema VB for Applications ...

Microsoft Office
gelöst Excel Dateien durchsuchen und Teile extrahieren (14)

Frage von Beranavan zum Thema Microsoft Office ...

Microsoft Office
gelöst Inhalte vieler excel dateien auslesen und als Liste wiedergeben (13)

Frage von tw3aker zum Thema Microsoft Office ...

Neue Wissensbeiträge
Ubuntu

Ubuntu 17.10 steht zum Download bereit

(3)

Information von Frank zum Thema Ubuntu ...

Datenschutz

Autofahrer-Pranger - Bewertungsportal illegal

(8)

Information von BassFishFox zum Thema Datenschutz ...

Windows 10

Neues Win10 Funktionsupdate verbuggt RemoteApp

(8)

Information von thomasreischer zum Thema Windows 10 ...

Microsoft

Die neuen RSAT-Tools für Win10 1709 sind da

(2)

Information von DerWoWusste zum Thema Microsoft ...

Heiß diskutierte Inhalte
Monitoring
Netzwerk-Monitoring Software (18)

Frage von Ghost108 zum Thema Monitoring ...

Windows 10
Seekrank bei Windows 10 (18)

Frage von zauberer123 zum Thema Windows 10 ...

Windows 10
Windows 10 Fall Creators Update Fehler (13)

Frage von ZeroCool23 zum Thema Windows 10 ...