Registriert seit: 10.01.2015
Version(en): 2007
Super!!!!!!!!!!!!!!!! :23:
Jetzt kann ich es halbwegs nachvollziehen.
Ist es noch möglich in Tabelle1 die Zellen Rot zu markieren die es nicht gefunden hat?
Registriert seit: 14.04.2014
Version(en): 2003, 2007
Hallo,
Stefans Code so erweitert müsste Deinem Wunsch entsprechen:
Code:
Sub prcKopieren()
Dim lngC As Long, lngZ As Long
Dim rngSuche As Range
Application.ScreenUpdating = False 'Bidschirmaktuallisierung aus
With Worksheets("Tabelle1")
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte belgte Zeile in Spalte A
.Range("A3:A" & lngZ).Interior.ColorIndex = xlNone 'A3:A bis letzte belegte Zeile Farben raus
'eine Schleife durch die Spalte A der Tabelle1 bis zum Ende
For lngC = 3 To lngZ
If InStr(.Cells(lngC, 1), "Überschrift") = 0 Then 'wenn Zelle nicht "Überschrift"
'der Wert aus der Zelle A... wird in der Tabelle Rohdaten gesucht
Set rngSuche = Worksheets("Rohdaten").Columns(1).Find(.Cells(lngC, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
'wenn der Wert in der Tabelle Rohdaten gefunden wird
If Not rngSuche Is Nothing Then
.Cells(lngC, 1).Interior.ColorIndex = 3 'Zelle Rot
'wird die Zeile aus der Tabelle Rohdaten kopiert
rngSuche.Offset(, 6).Resize(, 10).Copy
'und in der Tabelle1 eingefügt
.Cells(lngC, 7).PasteSpecial xlValues
End If
End If
Next lngC
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True 'Bidschirmaktuallisierung ein
End Sub
Gruß Atilla
Registriert seit: 10.01.2015
Version(en): 2007
fast, mit deinem Code werden die gefundenen Rot markiert, was aber bei den nicht gefundenen sein sollte
Registriert seit: 14.04.2014
Version(en): 2003, 2007
Hallo,
dann so:
Code:
Sub prcKopieren()
Dim lngC As Long, lngZ As Long
Dim rngSuche As Range
Application.ScreenUpdating = False 'Bidschirmaktuallisierung aus
With Worksheets("Tabelle1")
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte belgte Zeile in Spalte A
'eine Schleife durch die Spalte A der Tabelle1 bis zum Ende
For lngC = 3 To lngZ
If InStr(.Cells(lngC, 1), "Überschrift") = 0 Then 'wenn Zelle nicht "Überschrift"
'der Wert aus der Zelle A... wird in der Tabelle Rohdaten gesucht
Set rngSuche = Worksheets("Rohdaten").Columns(1).Find(.Cells(lngC, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
'wenn der Wert in der Tabelle Rohdaten gefunden wird
If Not rngSuche Is Nothing Then
.Cells(lngC, 1).Interior.ColorIndex = xlNone 'wenn gefunden dann Zellfarbe raus
'wird die Zeile aus der Tabelle Rohdaten kopiert
rngSuche.Offset(, 6).Resize(, 10).Copy
'und in der Tabelle1 eingefügt
.Cells(lngC, 7).PasteSpecial xlValues
Else
.Cells(lngC, 1).Interior.ColorIndex = 3 'Zelle Rot
End If
End If
Next lngC
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True 'Bidschirmaktuallisierung ein
End Sub
Die Zeilen mit Überschriften werden aussen vor gelassen.
Gruß Atilla
Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:1 Nutzer sagt Danke an atilla für diesen Beitrag 28
• JimmyJoe
Registriert seit: 10.01.2015
Version(en): 2007
Perfekt!!!!!!!!!!!!!!!!
vielen Dank an alle die mir geholfen haben :23:
Registriert seit: 10.01.2015
Version(en): 2007
Welche Voraussetzung muss die Zelle haben das sie als Überschrift erkannt wird?
Registriert seit: 11.04.2014
Version(en): Office 2007
Hallo,
das hat Atilla im Code eingebaut ansonsten würde ich dir mal diese
Seite empfehlen.
Gruß Stefan
Win 10 / Office 2016
Registriert seit: 14.04.2014
Version(en): 2003, 2007
Hallo zusammen,
Stefan, da hab ich wohl zu oberflächlich gedacht.
In der Überschriftzelle wird wahrscheinlich etwas anderes stehen als "Überschrift.."
@JimmyJoe
Formatier die Überschriftzelle Fett, dann ersetze im Code diese Zeile:
Code:
If InStr(.Cells(lngC, 1), "Überschrift") = 0 Then 'wenn Zelle nicht "Überschrift"
mit dieser:
Code:
If .Cells(lngC, 1).Font.Bold = False Then 'wenn Zelle nicht Fett formatiert"
Gruß Atilla
Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:1 Nutzer sagt Danke an atilla für diesen Beitrag 28
• JimmyJoe