Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<
Microsoft Office 2003-2019 => Excel => Thema gestartet von: joerg88 am August 07, 2016, 16:46:28 Nachmittag
-
Hallo zusammen,
ich bin blutiger Anfänger hinsichtlich VBA und habe noch nie eine Makro geschrieben. Leider stehe ich aktuell total auf dem Schlauch und weiß nicht wie ich meinen Code zu schreiben habe.
In Tabelle 2 finden sich ab Spalte B3 eine Mischung aus Zahlen-/ Buchstabencodes, welche als Suchkriterien dienen. Die Makro soll jeden einzelnen Wert nehmen und ihn mit den Rohdaten in Tabelle 1 vergleichen. Jedes Suchkriterium kommt in Spalte E (Tabelle 1) mehrfach vor, sodass hier eine Schleife nötig ist. Wenn also eine Übereinstimmung gefunden wurde, soll die komplette Zeile (A:M) kopiert werden und in Tabelle 3 (ab Zeile 2) eingefügt werden. Sofern dann alle Zeilen mit dem jeweiligen Code in den Output kopiert wurden, soll die ganze Prozedur mit dem nächsten Suchkritierium (aus Tabelle 2; Spalte E) wieder von vorne beginnen, bis auch der letzte Code (aus Tabelle 2) durch Tabelle 1 gelaufen ist und die Daten in Tabelle 3 ausgespuckt wurden.
Besten Dank schonmal
-
Moin Joerg,
können in Sheet2 (Suche) die Suchkriterien mehrfach vorkommen? Wenn nein, dann solltest du einmal in der auszuwertenden Tabelle einen Filter setzen und alles Sichtbare kopieren. Diesen Vorgang zeichnest du mit dem Makrorecorder auf. Danach de Code etwas bereinigen (Select, Activate raus) und dann per Schleife alle Positionen der Such-Liste abarbeiten.
Wenn du die Grundlagen gelegt hast, helfen wir dir hier gerne weiter. DieDatei ist dazu allerdings erforderlich ...
-
Moin Günther,
merci für deine Antwort.
Die Suchkriterien im Sheet2 kommen nur einmal vor, was den Code sicherlich vereinfachen sollte. Ich habe mich heute Nachmittag mal an die Makro gesetzt, bin mit meinem Latein aber nun am Ende. Vllt. kannst du mit meinem Script ja etwas anfangen und mir weiterhelfen.
By the way: Das File ist leider zu groß, weshalb ich einige Zeilen gelöscht habe und nur einen kleinen Auszug (hinsichtlich der Rohdaten& Suchkriterien) hochgeladen habe. Deshalb arbeite ich auch mit der Funktion letzteZeile ...
Dank & Gruß
Jörg
-
Moin Jörg,
du bist neu in Foren und auch in Sachen VBA. Darum sind die Hinweise Hilfestellungen und keine "Meckereien".
Musterdatei ist gut, aber es reiche normalerweise maximal 100 Zeilen.
Ich habe deinen Code mächtig aufgeräumt (Dein Original-Code ist auskommentiert):
'Sub FindenUndKopieren()
'
'Dim letzteZeile As Double
'Dim letzteZeile2 As Double
'Dim Zielzeile As Double
'Dim Zielspalte As Double
'Dim ZielPNR As String
'
'Application.ScreenUpdating = True
'
'ActiveWorkbook.Worksheets("Rohdaten").Select
'
' With ActiveSheet
'
' letztZeile = .Cells(Rows.Count, 1).End(xlUp)
'
' End With
'
' 'MsgBox letzteZeile
'
'ActiveWorkbook.Worksheets("PNR").Select
'
' With ActiveSheet
'
' letzteZeile2 = .Cells(Rows.Count, 2).End(xlUp)
'
' End With
'
' 'MsgBox letzteZeile2
'
'Zielzeile = 5
'
' Zielspalte = 2
'
' ZielPNR = ActiveWorkbook.Worksheets("PNR").Cells(i, 2)
'
' ActiveWorkbook.Worksheets("Output").Cells(Zielzeile, 1) = ZielPNR
'
' For k = 2 To 13
'
' ActiveWorkbook.Worksheets("Rohdaten").Select
' ActiveWorkbook.Worksheets("Rohdaten").Cells(j, k).Select
' Selection Copy
' ActiveWorkbook.Worksheets("Output").Select
' ActiveWorkbook.Worksheets("Output").Cells(Zielzeile, Zielspalte).Select
' ActiveSheet.Paste
'
' Zielspalte = Zielspalte + 1
'
' Next
'
' Zielzeile = Zielzeile + 1
'
'
'Next
'
'Next
'
'Application.ScreenUpdating = True
'
'End Sub
'####################################################################################
Option Explicit
Sub FindenUndKopieren()
Dim letzteZeile As Long 'Geändert
Dim letzteZeile2 As Long 'Geändert
Dim Zielzeile As Long 'Geändert
Dim Zielspalte As Long 'Geändert
Dim ZielPNR As String
Dim wksRoh As Worksheet, wksPNR As Worksheet, wksOutput As Worksheet
Dim i As Long, j As Long, k As Long
Application.ScreenUpdating = False 'Geändert
Set wksRoh = Worksheets("Rohdaten")
Set wksPNR = Worksheets("PNR")
Set wksOutput = Worksheets("Output")
letzteZeile = wksRoh.Cells(Rows.Count, 1).End(xlUp).Row
letzteZeile2 = wksPNR.Cells(Rows.Count, 2).End(xlUp).Row
Zielzeile = 5
Zielspalte = 2
'Irgendwie fehlt hier eine Schleife: For I = 1 To ???, darim per Hand initialisiert
'Gilt auch für j, darum habe ich dann auch die beiden NEXT unten deaktivieren müssen
i = 1
j = 1
ZielPNR = wksPNR.Cells(i, 2)
wksOutput.Cells(Zielzeile, 1) = ZielPNR
' For k = 2 To 13
' wksRoh.Cells.Cells(j, k).Copy wksOutput.Cells(Zielzeile, Zielspalte)
' Zielspalte = Zielspalte + 1
' Next k
' Na gut, das ist die geküzte Langform mit Schleife
' Meine Variante (falls ich die Positionierung in Output richtig verstanden habe:
wksRoh.Range("B1:M1").Copy
wksOutput.Range("A5:L5").PasteSpecial xlPasteValues
Zielzeile = Zielzeile + 1
'Next
'
'Next
Application.ScreenUpdating = True
End SubVersuche, die Kommentare zu verstehen und auch den geänderten Code. Diese ganze Select-Arie ist einfach unnötig, wie du siehst. Das brmst nur aus, auch wenn der Makrorecorder das mit aufzeichnet.
Wenn du das erarbeitet hast, mache aus den Rohdaten per Strg+T eine Tabelle.
Dann zeichnest du den folgenden Code auf:
Filter in Spalte E setzen
Strg+Pos1
Strg+CursorDown
Strg+A
Strg+C
Wechsel zu Output
Inhalt einfügen als Wert
Zurück zu Rohdaten
Filter entfernen (alle anzeigen)
Überarbeite dann noch einmal den oben stehenden Code und füge den aufgezeichneten Code ein. Vielleicht sogar etwas nachgearbeitet. Und das stellst du uns dann hier vor ...
-
Hallo Günther,
ich bin ja froh über jede Hilfe und da sind deine Hinweise eine super Hilfe. Deinen Code habe ich jedenfalls verstanden, was auch an der viel leichteren Struktur liegt.
Wenn ich die bisherige Makro laufen lasse, wird mir nichtsdestotrotz der folgende Fehler angezeigt:
Laufzeitfehler ‘438:
Objekt unterstützt diese Eigenschaft oder Methode nicht.
Option Explicit
Sub FindenUndKopieren()
Dim letzteZeile As Long
Dim letzteZeile2 As Long
Dim Zielzeile As Long
Dim Zielspalte As Long
Dim ZielPNR As String
Dim wksRoh As Worksheet, wksPNR As Worksheet, wksOutput As Worksheet
Dim i As Long, j As Long, k As Long
Application.ScreenUpdating = False
Set wksRoh = Worksheets("Rohdaten")
Set wksPNR = Worksheets("PNR")
Set wksOutput = Worksheets("Output")
letzteZeile = wksRoh.Cells(Rows.Count, 1).End(xlUp).Row
letzteZeile2 = wksPNR.Cells(Rows.Count, 2).End(xlUp).Row
Zielzeile = 5
Zielspalte = 2
i = 1
j = 1
wksRoh.Range("B1:M259192").Copy
wksOutput.Range("A5:L5").PasteSpecialxlPasteValues
Zielzeile = Zielzeile + 1
Application.ScreenUpdating = False
End Sub
Ansonsten habe ich deinen Tipp mit dem Makrorecorder umgesetzt. Dabei kam der folgende Code raus:
Sub Makro9()
'
' Makro9 Makro
'
'
Range("Tabelle2[[#Headers],[AMD_RECORD_LC_CODE]]").Select
Selection.AutoFilter
Sheets("PNR").Select
Range("B3").Select
ActiveCell.FormulaR1C1 = "29RT5J"
Sheets("Rohdaten").Select
ActiveSheet.ListObjects("Tabelle2").Range.AutoFilter Field:=5, Criteria1:= _
"29RT5J"
Range("E131277").Select
Range(Selection, Selection.End(xlDown)).Select
Range("Tabelle2").Select
Range("E131277").Activate
Selection.Copy
Sheets("Output").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A11").Select
Sheets("Rohdaten").Select
ActiveSheet.ListObjects("Tabelle2").Range.AutoFilter Field:=5
End Sub
Wäret du vllt. so freundlich mir wieder zu helfen, oder gar die gesamte Makro zu schreiben?
Dank und Gruß
Jörg