Schleife mit find
Hallo zusammen,
ich möchte aus zwei Registern Daten auslesen.
Also im ersten register1 steht zum Beispiel:
Im zweiten register2
Es soll nun die Textzeile im register2 zu den jeweiligen Keynamen im register1 kopiert werden.
Sie soll am Schluss so aussehen:
Das funktioniert auch soweit. Das Problem ist nur, dass ich folgendes Ergebnis bekomme:
Also eine Zeile verschoben.
Des weiteren möchte ich nicht das ganze Dokument durchsuchen.
Das verschieben der Zeile hat glaube ich mit der wenn-Formel zu tun. Die nimmt einen Falschen wert. Wie kann ich die Wenn-Formel umschreiben, damit ich dann den Wert, der neben dem gleichen Key steht bekomme?
So sieht ein Teil meines Scriptes aus:
Sub Makrosuche()
Dim wsnew As Worksheet
Dim wsnew2 As Worksheet
Dim bereichblatt2 As Range
Dim suchwert As String
Dim SpalteA As Long
Dim hochzaehlen As Long
'Name der 1.Tabelle,
Sheets(1).Name = "zusammengefügt"
Sheets(2).Name = "unsortiert"
Sheets(1).Select
Set wsnew = ActiveWorkbook.Sheets("zusammengefügt")
'Spalte vom Text
SpalteA = 1
'Name der 2.Tabelle
Set wsnew2 = ActiveWorkbook.Sheets("unsortiert")
' ================================================================================
' Schleife beginnt
' ================================================================================
For hochzaehlen = 2 To wsnew.Cells(wsnew.Rows.Count, 1).End(xlUp).Row
suchwert = wsnew.Cells(hochzaehlen, SpalteA)
Set bereichblatt2 = wsnew2.Cells.Find(What:=suchwert, LookIn:=xlValues, LookAt:=xlPart)
If Not bereichblatt2 Is Nothing Then
wsnew.Cells(hochzaehlen, SplateA + 2) = "Daten vorhanden"
Else
wsnew.Cells(hochzaehlen, SplateA + 2) = "Keine Daten vorhanden"
End If
' ================================================================================
' Wenn-Formel
' ================================================================================
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]=""Daten vorhanden"",unsortiert!RC[-1],"""")"
Selection.AutoFill Destination:=Range("C2:C7"), Type:=xlFillDefault
Range("C2:C7").Select
Next hochzaehlen
Sheets(1).Select
Range("A10").Select
' ================================================================================
' Datenblatt verstecken
' ================================================================================
'Sheets("unsortiert").Visible = xlVeryHidden
' ================================================================================
' Makro löschen
' ================================================================================
'Set VBComp = ThisWorkbook.VBProject.VBComponents("Modul1")
'ThisWorkbook.VBProject.VBComponents.Remove VBComp
End Sub
Habt ihr eine Idee?
Vielen Dank im voraus
ich möchte aus zwei Registern Daten auslesen.
Also im ersten register1 steht zum Beispiel:
Key
hker
ewrwe
ccc
dsfrewr
zzz
ggg
Key Text
123 zuzuz
dddd jkjk
fff sss
ccc ssssss
zzzz ggg
zzz jkhkg
ggg mmm
Es soll nun die Textzeile im register2 zu den jeweiligen Keynamen im register1 kopiert werden.
Sie soll am Schluss so aussehen:
Key
hker Keine Daten vorhanden
ewrwe Keine Daten vorhanden
ccc Daten vorhanden ssssss
dsfrewr Keine Daten vorhanden
zzz Daten vorhanden jkhkg
ggg Daten vorhanden mmm
Das funktioniert auch soweit. Das Problem ist nur, dass ich folgendes Ergebnis bekomme:
Key
hker Keine Daten vorhanden
ewrwe Keine Daten vorhanden
ccc Daten vorhanden sss
dsfrewr Keine Daten vorhanden
zzz Daten vorhanden ggg
ggg Daten vorhanden jkhkg
Also eine Zeile verschoben.
Des weiteren möchte ich nicht das ganze Dokument durchsuchen.
Das verschieben der Zeile hat glaube ich mit der wenn-Formel zu tun. Die nimmt einen Falschen wert. Wie kann ich die Wenn-Formel umschreiben, damit ich dann den Wert, der neben dem gleichen Key steht bekomme?
So sieht ein Teil meines Scriptes aus:
Sub Makrosuche()
Dim wsnew As Worksheet
Dim wsnew2 As Worksheet
Dim bereichblatt2 As Range
Dim suchwert As String
Dim SpalteA As Long
Dim hochzaehlen As Long
'Name der 1.Tabelle,
Sheets(1).Name = "zusammengefügt"
Sheets(2).Name = "unsortiert"
Sheets(1).Select
Set wsnew = ActiveWorkbook.Sheets("zusammengefügt")
'Spalte vom Text
SpalteA = 1
'Name der 2.Tabelle
Set wsnew2 = ActiveWorkbook.Sheets("unsortiert")
' ================================================================================
' Schleife beginnt
' ================================================================================
For hochzaehlen = 2 To wsnew.Cells(wsnew.Rows.Count, 1).End(xlUp).Row
suchwert = wsnew.Cells(hochzaehlen, SpalteA)
Set bereichblatt2 = wsnew2.Cells.Find(What:=suchwert, LookIn:=xlValues, LookAt:=xlPart)
If Not bereichblatt2 Is Nothing Then
wsnew.Cells(hochzaehlen, SplateA + 2) = "Daten vorhanden"
Else
wsnew.Cells(hochzaehlen, SplateA + 2) = "Keine Daten vorhanden"
End If
' ================================================================================
' Wenn-Formel
' ================================================================================
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]=""Daten vorhanden"",unsortiert!RC[-1],"""")"
Selection.AutoFill Destination:=Range("C2:C7"), Type:=xlFillDefault
Range("C2:C7").Select
Next hochzaehlen
Sheets(1).Select
Range("A10").Select
' ================================================================================
' Datenblatt verstecken
' ================================================================================
'Sheets("unsortiert").Visible = xlVeryHidden
' ================================================================================
' Makro löschen
' ================================================================================
'Set VBComp = ThisWorkbook.VBProject.VBComponents("Modul1")
'ThisWorkbook.VBProject.VBComponents.Remove VBComp
End Sub
Habt ihr eine Idee?
Vielen Dank im voraus
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 126027
Url: https://administrator.de/contentid/126027
Ausgedruckt am: 14.11.2024 um 17:11 Uhr
4 Kommentare
Neuester Kommentar
Hallo Philippe_M!
Die Suchfunktion funktioniert in etwa so:
Gruß Dieter
Die Suchfunktion funktioniert in etwa so:
Sub test()
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
For i = 2 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
Set Found = ws2.Range("A:A").Find(What:=ws1.Cells(i, 1), LookIn:=xlValues, LookAt:=xlWhole)
If Found Is Nothing Then
ws1.Cells(i, 2) = "Keine Daten vorhanden"
Else
ws1.Cells(i, 2) = "Daten vorhanden": ws1.Cells(i, 3) = Found.Offset(0, 1)
End If
Next
End Sub
Gruß Dieter
Hallo Philippe_M!
Danke, dann bin ich ja beruhigt
Ich habe Den Text X-mal durchgelesen und dachte ich steh im Wald.
Gruß Dieter
Danke, dann bin ich ja beruhigt
Ich habe Den Text X-mal durchgelesen und dachte ich steh im Wald.
Gruß Dieter