VBA suchen und finden

[gehtnetgibtsnet]

Hallo.
Gibt es in VBA eine Funktion, in einer aufsteigend sortierten Spalte einen bestimmten Begriff zu finden. Wenn es den Begriff nicht gibt, möchte ich gerne wissen, in welche Zeile ich ihn einfügen müsste.

 

[Skidrow1988]

Du kannst mit einer Schleife von unten nach oben danach suchen.

Sub wortFinden()
Dim i, x As Long
Dim strFind as String
strFind = DEINBEGRIFF
x = 0
For i = 1 To Worksheets(DEINWORKSHEETNAME).Cells(Rows.Count, 1).End(xlUp).Row
if Worksheets.cells(i,1).Text = strFind then
x = x +1
End in
Next i

if x = 0 then
Msgbox „Der Begriff muss in Zeile“ & Worksheets(DEINWORKSHEETNAME).Cells(Rows.Count, 1).End(xlUp).Row + 1 & „eingetragen werden“
Else
Msgbox „Der Begriff befindet sich in Reihe“ & x
End in
End Sub


Ungetestet! Bin leider am iPad

 

[cumulonimbus8]

Keine festverdrahtete. Du wirst es direkt programmieren müssen.
Aber das steht ja schon bei Skidrow1988 🙂 👍
CN8

 

[CyborgBeta]

Wenn die Spaltenlänge bekannt ist (oder Zeilenlänge, hab deine Anforderungsbeschreibung noch nicht genau verstanden), schreib dir eine binäre Suche gerade selbst... (Wenn sie nicht bekannt ist, wird das Ermitteln selbiger wohl mehr Zeit in Anspruch nehmen wie die Suche....)

Bei einer Länge von 1000 sparst du damit 99% Zeit ein, bei einer Länge von 100.000 sparst du 99,98% Zeit.

 

[Darkman.X]

@Skidrow1988:
Ich glaube, dass du die Anforderung falsch verstanden hast, besonders den letzten Teil:

Wenn es den Begriff nicht gibt, möchte ich gerne wissen, in welche Zeile ich ihn einfügen müsste.

Ich verstehe es so: Wenn die Liste z.B. "Affe", "Hund" und "Katze" hat, dann soll das Makro zeigen, in welche Zeile der "Esel" eingetragen werden muss --> Zeile 2 (Zeile einfügen und dann das Wort eintragen).
Dein Makro zeigt einfach nur die nächste freie Zeile an.

So zumindest habe ich es verstanden.

 

[CyborgBeta]

@Darkman.X Das ändert an der binären Suche ja nichts... Das Verfahren ist dasselbe, er müsste fürs Einfügen halt alle nachfolgenden Elemente aufrücken, insofern es keine Funktion dafür in VBA gibt...

Hier ist ein JavaScript-Beispiel, das nur noch in die VBA-Syntax überführt werden müsste:

function b_search(a, x) {
  let min = 0;
  let max = a.length;
  let mid = Math.floor(min + (max - min) / 2);
  let prev = max;
  while (mid != prev) {
    if (a[mid] == x) {
      return mid;
    }
    if (a[mid] < x) {
      min = mid;
    } else {
      max = mid;
    }
    prev = mid;
    mid = Math.floor(min + (max - min) / 2);
  }
  return -min;
}

function insert_if_absent(a, x) {
  if (!a.length) {
    a.push(x);
    return a;
  }

  let i = b_search(a, x);
  if (i > 0 || i == 0 && a[0] == x) {
    return a;
  }
  if (i != 0 || a[0] < x) {
    i = -i + 1;
  }
  if (i == a.length) {
    a.push(x);
    return a;
  }
  let y = a[i];
  a[i] = x;
  for (let j = i + 1; j < a.length - 1; j++) {
    a[j] = y;
    y = a[j + 1];
  }
  a.push(y);
  return a;
}

let a = [-3, -1, 4, 5, 8, 9, 10, 11, 15];
console.log(b_search(a, 11));
console.log(b_search(a, 20));
console.log(b_search(a, 0));

let b = [];
insert_if_absent(b, 1);
insert_if_absent(b, 1);
insert_if_absent(b, 1);
insert_if_absent(b, 3);
insert_if_absent(b, -1);
insert_if_absent(b, 0);
insert_if_absent(b, 3);
insert_if_absent(b, 2);
console.log(b);

b_search ist dabei die Binäre Suche. Wenn es das Element nicht gibt, wird der negative Einfüge-Index zurückgegeben.

(Unter Vorbehalt der Richtigkeit, an der ein oder anderen Stelle kann vielleicht noch eine Var eingespart werden )

 

[gehtnetgibtsnet]

@Skidrow1988

Sorry. Aber das ist nicht die Lösung, die ich gesucht hatte.

1. Es ist keine Funktion, sondern eine Lösung mit einer Loop.
2. Der Code funktioniert nur, wenn es den gesuchten Begriff gibt.
3. Um einen Begriff zu suchen, kann die Funktion "Find" benutzt werden. Man kann auch feststellen, ob der Begriff gefunden wurde.

Ich suche eine Lösung dafür, entweder die Stelle zu finden, an welcher der gesuchte Begriff gefunden wurde oder die Stelle (Zeile) in welcher ich eine neue Zeile mit dem gesuchten und nicht gefundenen Begriff einfügen sollte, damit er bei weiteren Suchläufen gefunden wird

@cumulonimbus8

Um das zu vermeiden suche ich eine passende Funktion

@CyborgBeta

Mit dem Begriff "binäre Suche" kann ich nichts anfangen.

Wie soll ich einen Javascript nach VBA umsetzen, wenn ich Javascript nicht verstehe?

@Darkman.X

Huch. Es gibt sie doch noch: Anwender, welche die Basis-Frage verstanden haben.

 

[Scientist]

cumulonimbus8 hat deine Frage beantwortet: Solche eine Funktion gibt es nicht. Folglich musst du selbst ran und deshalb kamen auch Code-Beispiele.

Geht es bei dem Problem nur darum, die Liste korrekt zu erweitern oder wirklich um die Position?
Erstes ist simple, letztes komplex.

 

[Skidrow1988]

Du könntest 2 arrays erstellen und beim 2. deinen Begriff einfügen. Dann vergleichen, wo der Begriff eingefügt wurde.

 

[CyborgBeta]

Mit dem Begriff "binäre Suche" kann ich nichts anfangen.

Wie soll ich einen Javascript nach VBA umsetzen, wenn ich Javascript nicht verstehe?

Was soll das denn heißen? Ich habe dir das Verfahren genannt/gezeigt, um den Einfüge-Index effizient zu ermitteln: in Pseudocode bzw. JS-Code.

Ich habe aber Execel/VBA gerade nicht installiert, sonst hätte ich dir eine entsprechende Funktion geschrieben.

Aber der grundsätzliche Ablauf sieht folgendermaßen aus (PAP):

lg

 

[CyborgBeta]

Mir ist gerade noch eingefallen, in VBA/Excel kann man sich einiges an Akrobatik sparen, weil die Reihen- und Spalten-Indexe mit 1 anstatt 0 beginnen... Das heißt, i<0 := nicht gefunden & einfügen ab Index (-i) ; i>0 := gefunden & Element hat Index i.

 

[cumulonimbus8]

(Der PAP / PaPl hat nostalgische Gefühle geweckt, ich musste ein Tränchen verdrücken.
CN8)

 

[CyborgBeta]

@cumulonimbus8 Danke dir.

So, ich habe nun mal Excel installiert und hier wäre der VBA-Code:

Function getMaxRow(idx As Long) As Long
    Dim i As Long
    i = 1
    While Not IsEmpty(Cells(i, idx))
        i = i + 1
    Wend
    getMaxRow = i
End Function

Function getIndexFromRow(idx As Long, val As String) As Long
    Dim min, max, mid, oldMid, c As Long
    min = 1
    max = getMaxRow(idx)
    mid = min + (Int((max - min) / 2))
    oldMid = 0
    Do While mid <> oldMid
        c = StrComp(val, Cells(mid, idx))
        If c = 0 Then Exit Do
        If c < 0 Then
            max = mid
        Else
            min = mid
        End If
        oldMid = mid
        mid = min + (Int((max - min) / 2))
    Loop
    If mid = oldMid Then
        getIndexFromRow = -mid
    Else
        getIndexFromRow = mid
    End If
End Function

Function insertRowSortedIfAbsent(idx As Long, val As String)
    newIdx = getIndexFromRow(idx, val)
    If newIdx < 0 Then
        newIdx = -newIdx + 1
        Range(Cells(newIdx, 1), Cells(newIdx, idx)).Insert
        Cells(newIdx, idx).Value = val
    End If
End Function

Function insertRowExample()
    Const cIdx = 4
    Const val = "c"
    Call insertRowSortedIfAbsent(cIdx, val)
End Function

In Zeile 38 bin ich aber nicht sicher, warum er keine neue Zeile an Index 1 einfügen möchte (also vor allen anderen).

 

[gehtnetgibtsnet]

Geht nicht gibt es nicht!

Der Schwiegersohn eines Bekannten hat mich auf die Funktion "Application.Match" aufmerksam gemacht.

Ich habe folgenden Code erfolgreich getestet; für mich ist das Thema damit erledigt:

Sub Suchenundeinfügen()
Dim Namen As Variant
Dim Result As Variant
Cells(1, 2).Value = "Elefant"
Cells(2, 2).Value = "Hund"
Cells(3, 2).Value = "Katze"
Cells(4, 2).Value = "Maus"
Namen = Split("Jaguar,Zebra,Hund,Pferd,Ente,Aal", ",")
Dim N As Integer
For N = LBound(Namen) To UBound(Namen)
Result = Application.Match(Namen(N), Range(Cells(1, 2), Cells(4, 2)), 1)
If IsError(Result) Then
Debug.Print Namen(N) & " muss ganz vorne eingefügt werden"
Else
If Cells(Result, 2).Value = Namen(N) Then
Debug.Print Namen(N) & " gefunden in Zeile " & Result
Else
Debug.Print Namen(N) & " muss nach Zeile " & Result & _
" (" & Cells(0 + Result, 2).Value & ") eingefügt werden"
End If
End If
Next N
End Sub

Das Test-Ergebnis:
Jaguar muss nach Zeile 2 (Hund) eingefügt werden
Zebra muss nach Zeile 4 (Maus) eingefügt werden
Hund gefunden in Zeile 2
Pferd muss nach Zeile 4 (Maus) eingefügt werden
Ente muss nach Zeile 1 (Elefant) eingefügt werden
Aal muss ganz vorne eingefügt werden

 

[CyborgBeta]

Ist halt mit magischen Konstanten und daher nicht brauchbar. Aber schön, wenn jeder Laie es besser weiß.

 

[Skidrow1988]

Ein solches Beispiel hätte man vorher zeugen können.

 

[gehtnetgibtsnet]

@CyborgBeta

Was sind bei Dir "magische Konstanten"? Nur weil ich in einem Beispiel ein paar Begriffe verwendet habe?

@Skidrow1988

Wie hätte ich ein Beispiel machen können, wenn ich den Lösungsweg noch nicht kannte? Und in meinem Thread-Start hatte ich genau beschrieben, was mein Problem ist. Darkman.X hat es genau erkannt.

 

[Skidrow1988]

Man kann ein Anfangsszenario und ein Endszenario erstellen. Dafür muss man keinen Code haben.

 

[CyborgBeta]

Magische Konstanten sind festcodirte Werte, die nicht generisch sind, und sich nur auf einen Fall beziehen.

Bei dir heißt das, sobald du etwas anderes wie Hund,Katze,Maus verwenden willst, geht das schief.