Excel Suchfunktion

[Rabe]

Hi,

Code:

Sobald ich in Spalte C mehr Zeilen habe als in Spalte A, ist die Zuordnung falsch!

kann ich nicht nachvollziehen. Da solltest Du mal eine realistische Datei zeigen!

so geht das nicht:

Tabelle1

	A	B	C	D
1	Name neu	Bedingung	Name alt	Name neu
2	ALDI Frankfurt	aldi*frankfurt	ALDI GMBH + CO. FRANKFURT / ALDI SUED SAGT DANKE	ALDI Frankfurt
3	ALDI Darmstadt	aldi*darmstadt	ALDI GMBH + CO. KG//DARMSTADT/DE / ALDI SUED SAGT DANKE	ALDI Darmstadt
4	LIDL	lidl	DANKE, IHR LIDL//Neustadt a/DE / DANKE, IHR LIDL	LIDL
5	REWE Frankfurt	rewe*ffm	REWE Frankfurt	REWE Frankfurt
6	REWE Frankfurt	rewe*frankfurt	REWE Ffm-Griesheim	REWE Frankfurt
7			ALDI GMBH + CO. FRANKFURT / ALDI SUED SAGT DANKE	#WERT!
8			ALDI GMBH + CO. KG//DARMSTADT/DE / ALDI SUED SAGT DANKE	#WERT!
9			DANKE, IHR LIDL//Neustadt a/DE / DANKE, IHR LIDL	#WERT!
10			REWE Frankfurt	#WERT!
11			REWE Ffm-Griesheim	#WERT!

verwendete Formeln
Zelle	Formel	Bereich	N/A
D2: D11	=INDEX(A:A;VERGLEICH("*"&Tabelle3[@Bedingung]&"*";C:C;0))

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 19.08 einschl. 64 Bit

[atilla]

Halle zusammen,

Man braucht hier Vba

Ob es mit einer Arrayformel geht, kann ich nicht beurteilen.
Der TE hat zwei Tabellen.
Eine Datentabelle und eine Vergleichstabelle. Es wird geprüft, ob in einem Wert der Datentabelle eines der Werte der Vergleichstabelle enthält.

[atilla]

Hallo zusammen,

hier eine VBA Lösung:

Code:

Sub Inhalte_tauschen()
 Dim lngZ As Long, i As Long, j As Long

 Dim SuchenNach
 Dim ErsetzenDurch
 Dim feldErsetzen

  lngZ = Cells(Rows.Count, 3).End(xlUp).Row
  SuchenNach = Range("B2:B6")
  ErsetzenDurch = Range("A2:A6")
  feldErsetzen = Range("C2:C" & lngZ)
 
  For i = 1 To lngZ - 1
    For j = LBound(SuchenNach) To UBound(SuchenNach)
      If Not IsError(Application.Search(SuchenNach(j, 1), feldErsetzen(i, 1))) Then
        feldErsetzen(i, 1) = ErsetzenDurch(j, 1)
      End If
    Next j
  Next i
 
  Range("D2:D" & lngZ) = feldErsetzen
 
End Sub

[clippers41]

Hallo,

Code:

Sobald ich in Spalte C mehr Zeilen habe als in Spalte A, ist die Zuordnung falsch!

kann ich nicht nachvollziehen. Da solltest Du mal eine realistische Datei zeigen!

  Mappe2.xlsx (Größe: 14,08 KB / Downloads: 4)
In Spalte E findest du das Ergebnis deiner Formel und in Spalte F das gewünschte Ergebnis der verschachtelten Formel. Danke! :)

[clippers41]

Hallo zusammen,

hier eine VBA Lösung:

Code:

Sub Inhalte_tauschen()
 Dim lngZ As Long, i As Long, j As Long

 Dim SuchenNach
 Dim ErsetzenDurch
 Dim feldErsetzen

  lngZ = Cells(Rows.Count, 3).End(xlUp).Row
  SuchenNach = Range("B2:B6")
  ErsetzenDurch = Range("A2:A6")
  feldErsetzen = Range("C2:C" & lngZ)
 
  For i = 1 To lngZ - 1
    For j = LBound(SuchenNach) To UBound(SuchenNach)
      If Not IsError(Application.Search(SuchenNach(j, 1), feldErsetzen(i, 1))) Then
        feldErsetzen(i, 1) = ErsetzenDurch(j, 1)
      End If
    Next j
  Next i
 
  Range("D2:D" & lngZ) = feldErsetzen
 
End Sub

Hallo atilla,
danke für deine Lösung!
Kann ich die VBA Formeln denn irgendwie so gestalten, dass sie sich nicht auf bestimmte Zellen/Bereiche beziehen, sondern immer auf die gesamte erste Spalte der linken Tabelle (egal wie viel Zeilen sie lang ist)?

[atilla]

Hallo,

ja das ist möglich.

Unten der Code ist auf die zuletzt eingestellte Datei angepasst und ist dynamisch.
Außerdem habe noch eingebaut, dass bei keiner möglichen Ersetzung "Kein Ersatz" in die Zelle geschrieben wird.

Code:

Sub Inhalte_tauschen()
 Dim boVar As Boolean
 Dim lngZ As Long, i As Long, j As Long
 Dim lngZSuch As Long

 Dim SuchenNach
 Dim ErsetzenDurch
 Dim feldErsetzen
 
 lngZSuch = Cells(Rows.Count, 1).End(xlUp).Row
 lngZ = Cells(Rows.Count, 4).End(xlUp).Row
 SuchenNach = Range("B2:B" & lngZSuch)
 ErsetzenDurch = Range("A2:A" & lngZSuch)
 feldErsetzen = Range("D2:D" & lngZ)

 For i = 1 To lngZ - 1
   For j = LBound(SuchenNach) To UBound(SuchenNach)
     If Not IsError(Application.Search(SuchenNach(j, 1), feldErsetzen(i, 1))) Then
       feldErsetzen(i, 1) = ErsetzenDurch(j, 1)
       boVar = True
     End If
     If boVar = False Then
       feldErsetzen(i, 1) = "Kein Ersatz!"
     End If
   Next j
 Next i
 
 Range("F2:F" & lngZ) = feldErsetzen
 
End Sub

[Rabe]

Hi,

Kann ich die VBA Formeln denn irgendwie so gestalten, dass sie sich nicht auf bestimmte Zellen/Bereiche beziehen, sondern immer auf die gesamte erste Spalte der linken Tabelle (egal wie viel Zeilen sie lang ist)?

so kannst Du die letzte belegte Zeile in A feststellen:
lngZ_A = Cells(Rows.Count, 1).End(xlUp).Row

dann:
lngZ = Cells(Rows.Count, 3).End(xlUp).Row
SuchenNach = Range("B2:B" &lngZ_A)
ErsetzenDurch = Range("A2:A" &lngZ_A)
feldErsetzen = Range("C2:C" & lngZ)

[atilla]

Hallo,

kleine Korrektur "Kein Ersatz" muss etwas später sein im Code und muss noch etwas kontrollierter genutzt werden.

Code:

Sub Inhalte_tauschen()
  Dim boVar As Boolean
  Dim lngZ As Long, i As Long, j As Long
  Dim lngZSuch As Long

  Dim SuchenNach
  Dim ErsetzenDurch
  Dim feldErsetzen
 
  lngZSuch = Cells(Rows.Count, 1).End(xlUp).Row
  lngZ = Cells(Rows.Count, 4).End(xlUp).Row
  SuchenNach = Range("B2:B" & lngZSuch)
  ErsetzenDurch = Range("A2:A" & lngZSuch)
  feldErsetzen = Range("D2:D" & lngZ)
 
  For i = 1 To lngZ - 1
    boVar = False
    For j = LBound(SuchenNach) To UBound(SuchenNach)
      If Not IsError(Application.Search(SuchenNach(j, 1), feldErsetzen(i, 1))) Then
        feldErsetzen(i, 1) = ErsetzenDurch(j, 1)
        boVar = True
      End If
    Next j
    If boVar = False Then
      feldErsetzen(i, 1) = "Kein Ersatz!"
    End If
  Next i
 
  Range("F2:F" & lngZ) = feldErsetzen
 
End Sub

[clippers41]

Mein Code wurde etwas verändert und schaut nun so aus:

Code:

Sub Adressat_formatieren()
 Dim boVar As Boolean
 Dim lngZ As Long, i As Long, j As Long
 Dim lngZSuch As Long

 Dim SuchenNach
 Dim ErsetzenDurch
 Dim feldErsetzen
 
 lngZSuch = Cells(Rows.Count, 20).End(xlUp).Row
 lngZ = Cells(Rows.Count, 5).End(xlUp).Row
 SuchenNach = Range("T6:T" & lngZSuch)
 ErsetzenDurch = Range("U6:U" & lngZSuch)
 feldErsetzen = Range("E3:E" & lngZ)

 For i = 1 To lngZ - 1
   boVar = False
   For j = LBound(SuchenNach) To UBound(SuchenNach)
     If Not IsError(Application.Search(SuchenNach(j, 1), feldErsetzen(i, 1))) Then
       feldErsetzen(i, 1) = ErsetzenDurch(j, 1)
       boVar = True
     End If
   Next j
   If boVar = False Then
     feldErsetzen(i, 1) = ""
   End If
 Next i
 
 Range("N3:N" & lngZ) = feldErsetzen
 
End Sub

  Mappe3.xlsm (Größe: 38,2 KB / Downloads: 4)
Beim Durchlauf der Routine bekomme ich die Meldung "Index außerhalb des gültigen Bereichs"..

[atilla]

Hallo,


da deine Daten ab Zeile 2 anfangen muss noch folgende Zeile angepasst werden:

For i = 1 To lngZ - 2  '2 statt bisher 1