Hilfe Bitte Bitte Hilfe

Hallo Thors-Hammer-,

habe den Code nochmal überarbeitet.

Falls der Suchwert in der Matrix mehrfach vorkommt,
werden diese Fundzellen in der Zielspalte F dokumentiert.

Code:

Option Explicit

Sub Suchen()
  Dim Quelle As Worksheet
  Dim Matrix As Range
  Dim c, Suchwert$, Zielwert$, Fundzelle
  Dim l&, q%, z%
  Set Quelle = Worksheets("Daten")
  Set Matrix = Worksheets("Berechnung").Range("A3:N200")
  q = 4
  z = 6
  Application.ScreenUpdating = False

  For l = 9 To 39
    Suchwert = Quelle.Cells(l, q)
    Quelle.Cells(l, z).ClearContents

    With Matrix

      Set c = .Find(Suchwert, LookIn:=xlValues, lookat:=xlWhole)

      If Not c Is Nothing Then
        Fundzelle = c.Address(False, False)
        Do
          Set c = .FindNext(c)
          If Quelle.Cells(l, z) = "" Then
            Quelle.Cells(l, z) = c.Address(False, False)
          Else
            Quelle.Cells(l, z) = Quelle.Cells(l, z) & ";" & c.Address(False, False)
          End If
        Loop While Not c Is Nothing And c.Address(False, False) <> Fundzelle
      Else
        Quelle.Cells(l, z) = "-"
      End If

    End With
  Next l

  Quelle.Columns(z).AutoFit

  Application.ScreenUpdating = True
End Sub

Code eingefügt mit Syntaxhighlighter 2.1

Beispielmappe:

https://www.herber.de/bbs/user/2696.xls

Ciao MikeS

Ich weiß nicht, ob ich Dich richtig verstanden habe.

1.) Wenn der Wert in der Matrix gefunden wird,
soll er in die Zielspalte geschrieben werden!?

Was, wenn der Wert mehrfach in der Matrix vorkommt,
oder ist das nicht relevant?

Nachfolgender Code prüft, ob der Wert der Suchspalte mindestens
1x in der Matrix vorkommt.
Ist das der Fall, wird der Wert auch nur einmal in die Zielspalte
eingetragen.

Sub Suchen2()
  Dim Quelle As Worksheet
  Dim Matrix As Range
  Dim c, Suchwert$, Zielwert$, Fundzelle
  Dim l&, q%, z%
  Set Quelle = Worksheets("Daten")
  Set Matrix = Worksheets("Berechnung").Range("A3:N200")
  q = 4
  z = 6
  Application.ScreenUpdating = False

  For l = 9 To 39

    Suchwert = Quelle.Cells(l, q)
    Quelle.Cells(l, z).ClearContents

    With Matrix

      Set c = .Find(Suchwert, LookIn:=xlValues, lookat:=xlWhole)

      If Not c Is Nothing Then
        Quelle.Cells(l, z) = c.Value
      Else
        Quelle.Cells(l, z) = "-"
      End If

    End With

  Next l

  Quelle.Columns(z).AutoFit

  Application.ScreenUpdating = True
End Sub

Code eingefügt mit Syntaxhighlighter 2.1

War es das, was Du wolltest?

Ciao MikeS

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Hilfe Bitte Bitte Hilfe

02.01.2004 09:50:09

MikeS

AW: Hallo MikeS

03.01.2004 07:09:09

Thors-Hammer-

Verbesserung

03.01.2004 11:09:43

MikeS

AW: Verbesserung

03.01.2004 13:17:22

Thors-Hammer-

AW: Verbesserung

03.01.2004 16:17:00

MikeS

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread