Új hozzászólás Aktív témák

• #44118 Mutt senior tag p5quser #44115

  Új Válasz 2020-05-26 02:28:16 #44118

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Mutt

  senior tag

  válasz p5quser #44115 üzenetére

  Szia,

  A Split egy eredménytömböt próbál létrehozni, aminek az elemszáma a megtalált elválasztó karakterek száma alapján változik. Ha nem találja meg a karaktert, akkor 1 elemű lesz a tömb, a bemeneti értékkel az első elemben.

  A tömb elemszámát az UBOUND() függvény adja meg.
  Mielőtt a 3-ik elemet keresnéd meg kell nézned, hogy van-e egyáltalán?

  If UBound(spl) > 2 then
... 3-ik elemes keresésed
End if

  Ha jól értelmezem az eredeti felvetésedet, akkor ez a kód jobb eredményt fog adni mint a mostani.

  Sub Kereses()
Dim rngSearch As Range 'ez a B oszlop
Dim txSearch As Range 'ez a B oszlop éppen vizsgált cellája lesz
Dim arrWhat() 'ez a G oszlop
Dim txWhat As Variant 'a splittel ide szedjük szét fenti cella tartalmát
Dim match As Long 'találatok számolása
Dim bestmatch As Long 'legtöbb találat
Dim bestWhat As Long 'legtöbb találatot adó keresés pozíciója

Dim i As Long
Dim j As Long

With ActiveSheet
'memóriában tárolt tömbe töltjük a keresendõ kifejezések listáját
'Transpose 1-es index-szel induló tömböt hoz létre
arrWhat = Application.Transpose(.Range("G2:G180"))

Set rngSearch = .Range("B1:B" & .Range("B1").End(xlDown).Row)

For Each txSearch In rngSearch

bestmatch = 0
bestWhat = 0

For i = 1 To UBound(arrWhat)
'keresendõ szavak létrehozása
txWhat = Split(arrWhat(i), " ")

If IsArray(txWhat) Then
match = 0

'Split mindig 0-ás index-szel hozza létre a tömböt
For j = 0 To UBound(txWhat)
match = match - (InStr(1, UCase(txSearch), UCase(txWhat(j))) > 0)
Next j

'ha találtunk több egyezést a korábbiaknál, akkor jegyezzük meg
If match > bestmatch Then
bestmatch = match
bestWhat = i
End If
End If
Next i

'mielõtt új cellára mennénk a C-D oszlopban írjuk ki hogy mi a legjobb egyezésünk
If bestWhat > 0 Then
txSearch.Offset(, 1) = bestmatch
txSearch.Offset(, 2) = arrWhat(bestWhat)
End If
Next txSearch
End With


End Sub

  

  üdv

Új hozzászólás Aktív témák