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

• #48309 Pakliman tag oke #48308

  Új Válasz 2022-01-26 10:50:18 #48309

  Ú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

  

  Pakliman

  tag

  válasz oke #48308 üzenetére

  "Alakula molekula"
  A következő javaslatom lett volna a keresendő/beírandó lista egy külön táblázatba, de őszintén, nem mertem ajánlani, mert túl-túl kezdőnek látszottál az előzőek alapján. Így viszont már más a felállás

  Sub Fut()
'A főtáblára vonatkozó deklarációk:
Dim usF As Long
Dim sorF As Long
Dim elsősor As Long

'Főtábla utolsó sorának meghatározása
usF = Columns("AC").Rows(Rows.Count).End(xlUp).Row

'A keresendőket tartalmazó táblára vonatkozó deklarációk:
Dim wsK As Worksheet 'a hosszú "elnevezést" lecseréljük majd egy rövidre...
Dim usK As Long
Dim sorK As Long

'Az egyszerűség kedvéért úgy vesszük, hogy a MUNKAFÜZET már nyitva van,
'a neve Csere.xlsm, a keresendők listája a Keresendők nevű munkalapon van...
'A keresendő kifejezések az A oszlopban, a G-be írandók a B, a H-ba írandók pedig a C oszlopban vannak
'Feltételezzük, hogy az első sor fejléc...
'A keresendőket tartalmazó tábla utolsó sorának meghatározása...
Set wsK = Workbooks("Csere.xlsm").Worksheets("Keresendők")
usK = wsK.Columns("A").Rows(Rows.Count).End(xlUp).Row


elsősor = 2 'nem tudom, Nálad melyik sorban kezdődik:(
For sorF = elsősor To usF
'Csak akkor vizsgálódunk, ha a sorban a G és H oszlopban sincs még semmi...
If (Cells(sorF, "G") & Cells(sorF, "H")) = "" Then
'Feltétel(ek) vizsgálata...
'Sok feltételt vizsgálunk 1 cellában...
For sorK = 2 To usK
If Cells(sorF, "AC") Like "*" & wsK.Cells(sorK, "A") & "*" Then
Cells(sorF, "G") = wsK.Cells(sorK, "B")
Cells(sorF, "H") = wsK.Cells(sorK, "C")

'Mivel volt találat és a G és H oszlop ki van töltve,
'ezért a többi lehetőséget már nem vizsgáljuk!!
Exit For
End If
Next sorK
End If
Next sorF

End Sub

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