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

• bteebi veterán

  #40573

  #40534 Mutt

  2019-03-26 22:19:02

  Új Válasz

  Ú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

  

  bteebi

  veterán

  #40534 Mutt

  Szia!

  Kipróbáltam, működik . Le a kalappal a képletek előtt, a nagyobb részüket már meg is értettem.

  Aztán a végén véletlenül szinte biztos, hogy találtam egy hibát: a K oszlopban lévő képlet látszólagosan figyelmen kívül hagyja az autótípust, és a márka és szín alapján szűr (bár azok alapján, arra a két paraméterre, jól):

  

  Az ELTOLÁS függvény és a névkezelő viszonyát nem értettem, ezért erről beteszek egy képet:

  

  Az Érvényesítésnél meg ez van:

  

  Ettől teljesen függeltenül írtam egy makrót, ami egyelőre látszólag teljesen jól működik, és némi hibakezelés is van benne. Bemásolom ide, még jó kiindulási alap lehet másnak.

  Private Sub Worksheet_Change(ByVal Target As Range)

Dim rendszamok As String
Dim sor As Long
Dim usor As Long

'utolsó sor megkeresése
usor = Sheets("Feladat").Cells(Sheets("Feladat").Rows.Count, 1).End(xlUp).Row

For sor = 2 To usor

'Oszlopok összehasonlítása és a megfelelő rendszámok hozzáadása a rendszamok nevű listához
If Sheets("Feladat").Cells(sor, 1) & " " & Sheets("Feladat").Cells(sor, 2) & ", " _
& Sheets("Feladat").Cells(sor, 3) = Sheets("Feladat").Range("F2") Then
rendszamok = rendszamok & Sheets("Feladat").Cells(sor, "D") & ","
End If

Next sor

'Ha valamiért nem lenne megtalálható az adott típus, pl. hibás adatbevitel, akkor lépjen ki
If Len(rendszamok) < 1 Then

Application.EnableEvents = False

With Sheets("Feladat").Range("G2")
.ClearContents
.Validation.Delete
End With

Application.EnableEvents = True

MsgBox Sheets("Feladat").Range("F2") & " típusú autó" & vbCr & "nincs a listában. Ellenőrizd.", vbCritical, "Hiba!"
Exit Sub

Else

'Az utolsó vessző eltávolítása
rendszamok = Left(rendszamok, Len(rendszamok) - 1)

End If

'legördülő lista létrehozása a "rendszamok" nevű lista elemeivel
With Sheets("Feladat").Range("G2").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=rendszamok
End With

End Sub

  Ha van találat:

  

  Ha nincs találat:

  

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