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
GELÖST

Makro für Wort in Zeile suchen und enstrechende Spalte in neues Arbeitsblatt kopieren

Frage Entwicklung VB for Applications

Mitglied: Zebras

Zebras (Level 1) - Jetzt verbinden

01.06.2014, aktualisiert 17:00 Uhr, 1840 Aufrufe, 4 Kommentare, 2 Danke

Hi, ich stehe vor folgendem Problem:
Ich habe eine Ansammlung von Daten die sortiert werden muss. Dabei muss die erste Zeile nach einer Bezeichnung durchsucht werden und 2 dazugehörige Spalten in ein neues Arbeitsblatt kopiert werden. Wenn es den gesuchten Eintrag nicht gibt, sollen die 2 Spalten in der geordenten Reihenfolge leer bleiben. So wie in den beigefügten Bildern gezeigt.
Ich hoffe das es nicht zu schwer umzusetzten ist, da ich selbst nicht viel Verständnis darüber besitze. Ich bin über jede Hilfe dankbar : )

Wie es aussehen soll, wenn es sortiert wurde:
653958e25725f57c04f4124de5a3bf70 - Klicke auf das Bild, um es zu vergrößern

Wie die Rohdaten vorliegen:
f5adb419a847a841628319c1261a8b7f - Klicke auf das Bild, um es zu vergrößern

Mitglied: rubberman
LÖSUNG 01.06.2014, aktualisiert um 17:00 Uhr
Hallo Zebras,

könnte so aussehen.
01.
Sub CopyData() 
02.
    Dim lCols As Long, lLastNum As Long, lFound As Long, i As Long, _ 
03.
        strLast As String, strCurrHead, _ 
04.
        wsCopy As Excel.Worksheet, wsPaste As Excel.Worksheet, _ 
05.
        rgCopyHead As Excel.Range, rgFound As Excel.Range 
06.
 
07.
    Const strConstHead = "Versuch_" 
08.
    Set wsCopy = ThisWorkbook.Worksheets("Tabelle3") 
09.
    Set wsPaste = ThisWorkbook.Worksheets("Tabelle2") 
10.
 
11.
    lCols = wsCopy.UsedRange.Columns.Count 
12.
    Set rgCopyHead = wsCopy.Range(wsCopy.Cells(1, 1), wsCopy.Cells(1, lCols)) 
13.
    strLast = wsCopy.Cells(1, lCols - 1) 
14.
    lLastNum = CLng(Mid(strLast, InStrRev(strLast, "_") + 1)) 
15.
 
16.
    For i = 1 To lLastNum 
17.
        strCurrHead = strConstHead & CStr(i) 
18.
        Set rgFound = rgCopyHead.Find(strCurrHead, , , xlWhole, , , True) 
19.
        If rgFound Is Nothing Then 
20.
            wsPaste.Cells(1, i * 2 - 1) = strCurrHead 
21.
            wsPaste.Cells(1, i * 2).ClearContents 
22.
        Else 
23.
            lFound = rgFound.Column 
24.
            wsCopy.Range(wsCopy.Columns(lFound), wsCopy.Columns(lFound + 1)).Copy 
25.
            wsPaste.Range(wsPaste.Columns(i * 2 - 1), wsPaste.Columns(i * 2)).PasteSpecial 
26.
            Application.CutCopyMode = False 
27.
        End If 
28.
    Next 
29.
End Sub
Ich habe als größte Versuchsnummer in der Kopfzeile die letzte in der zu kopierenden Tabelle angenommen. Keine Ahnung ob das so OK ist.

Grüße
rubberman
Bitte warten ..
Mitglied: Zebras
01.06.2014, aktualisiert um 17:17 Uhr
Vielen vielen Dank für deine schnelle Antwort. Und es ist fast exakt so wie ich es bräuchte :D Idealer wäre es, wenn nicht nach dem festen Wert "Versuch_" gesucht wird, sondern nach den Inhalten der 1. Reihe des Arbeitsblatt 2. - > Wie z.B. A1:"Lac-1-AAE-1.csv" ; C1: "Lac-1-AAE-2.csv" ; E1: "LAC-1-FoPi-1.csv" ; usw.
Beste Grüße Zebras
Bitte warten ..
Mitglied: rubberman
01.06.2014 um 17:54 Uhr
Hallo Zebras,

mir war nicht bewusst, dass die Überschriften in Tabelle2 bereits vollständig existieren.
Teste:
01.
Sub CopyData() 
02.
    Dim lColsCopy As Long, lColsPaste As Long, lFound As Long, i As Long, _ 
03.
        strCurrHead As String, _ 
04.
        wsCopy As Excel.Worksheet, wsPaste As Excel.Worksheet, _ 
05.
        rgCopyHead As Excel.Range, rgFound As Excel.Range 
06.
 
07.
    Set wsCopy = ThisWorkbook.Worksheets("Tabelle3") 
08.
    Set wsPaste = ThisWorkbook.Worksheets("Tabelle2") 
09.
 
10.
    lColsCopy = wsCopy.UsedRange.Columns.Count 
11.
    lColsPaste = wsPaste.UsedRange.Columns.Count 
12.
    Set rgCopyHead = wsCopy.Range(wsCopy.Cells(1, 1), wsCopy.Cells(1, lColsCopy)) 
13.
 
14.
    For i = 1 To lColsPaste Step 2 
15.
        strCurrHead = wsPaste.Cells(1, i) 
16.
        Set rgFound = rgCopyHead.Find(strCurrHead, , , xlWhole, , , True) 
17.
        If Not rgFound Is Nothing Then 
18.
            lFound = rgFound.Column 
19.
            wsCopy.Range(wsCopy.Columns(lFound), wsCopy.Columns(lFound + 1)).Copy 
20.
            wsPaste.Range(wsPaste.Columns(i), wsPaste.Columns(i + 1)).PasteSpecial 
21.
            Application.CutCopyMode = False 
22.
        End If 
23.
    Next 
24.
End Sub
Grüße
rubberman
Bitte warten ..
Mitglied: Zebras
01.06.2014 um 18:33 Uhr
Klappt perfekt. Tausend Dank : )
Bitte warten ..
Ähnliche Inhalte
Microsoft Office
gelöst Dynamische tabellen erstellen und in einanderes arbeitsblatt kopieren (18)

Frage von hugothemagpie zum Thema Microsoft Office ...

Microsoft Office
gelöst Excel: Wenn Wert in Spalte A dann kopiere Zeile (8)

Frage von michi1983 zum Thema Microsoft Office ...

VB for Applications
Excel Makro zum Suchen von Spalten und exportieren in CSV (3)

Frage von Raptox zum Thema VB for Applications ...

Neue Wissensbeiträge
Peripheriegeräte

Was beachten bei der Wahl einer USV Anlage im Serverschrank

(2)

Tipp von zetboxit zum Thema Peripheriegeräte ...

Windows 10

Das Windows 10 Creators Update ist auf dem Weg

(5)

Anleitung von BassFishFox zum Thema Windows 10 ...

Administrator.de Feedback

Tipp: Ungelöste Fragen ohne Antwort in Tickeransicht farblich hinterlegen

Tipp von pattern zum Thema Administrator.de Feedback ...

Viren und Trojaner

Neue Magazin Ausgabe: Malware und Angriffe abwehren

Information von Frank zum Thema Viren und Trojaner ...

Heiß diskutierte Inhalte
Windows Systemdateien
Warum System auf "C:" (29)

Frage von DzumoPRO zum Thema Windows Systemdateien ...

Windows Server
gelöst Update BackupExec 2015 auf 2016 führt zu SQL-Server Problem (16)

Frage von montylein1981 zum Thema Windows Server ...

Cloud-Dienste
gelöst Bitcoins minen über Nacht? (16)

Frage von 1410640014 zum Thema Cloud-Dienste ...

LAN, WAN, Wireless
Cisco SG200: Auf bestimmtem vLAN bestimmte TCP-Ports sperren (16)

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