-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
bteebi
veterán
Sziasztok!
Van egy event makróm az adott munkalapban, ami a C oszlopban (3. oszlop) kiválasztott érték ("OK", "Rossz", vagy "N/A") alapján hoz létre a D oszlopban egy listát. De csak akkor, ha a kiválasztott érték a "Rossz". Emellett még rajzol egy keretet.
Az érdekesség az, hogy a makró önállóan lefuttatva (a célcellára ráállva) teljesen jól működik, de ha event makróként futtatnám (a Dim Target/Set Target sorok nélkül, de akár azokkal is) nem csinál semmit. Mi lehet a baj? Már az is felmerült bennem, hogy a dropdown miatt van, hogy esetleg a cellában az értékváltozást nem tekinti változásnak, de másik makrókban ugyanebben a munkafüzetben meg hibamentesen megy... Valahogy pedig nem triggerelődik az event...
Sub test()
'Private Sub Worksheet_Change(ByVal Target As Range)
Dim Target As Range
Set Target = ActiveCell
Dim rng As Range
If Target.Column = 3 Then
If Target.Value = "OK" Or Target.Value = "N/A" Then
Sheets("Stat").Cells(Target.Row, "D").ClearContents
Sheets("Stat").Cells(Target.Row, "D").Validation.Delete
End If
If Target.Value = "Rossz" Then
With Sheets("Stat").Cells(Target.Row, "D").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="Hiba 1,Hiba 2,Hiba 3,Hiba 4"
End With
End If
Set rng = Sheets("Stat").Range("D" & Target.Row & ":E" & Target.Row)
With rng.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With rng.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With rng.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With rng.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With rng.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End If
End SubVan valami ötletetek, hogy mi lehet a gond? Nagyon köszönöm!

Új hozzászólás Aktív témák
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Samsung Galaxy A32 5G / 4/128GB / Kártyafüggetlen / 12Hó garancia
- 193 - Lenovo Legion 5 (15IRX10) - Intel Core i7-14700HX, RTX 5070 (ELKELT)
- GYÖNYÖRŰ iPhone SE 2020 64GB Black -1 ÉV GARANCIA - Kártyafüggetlen, MS3920
- Lenovo IdeaPad Slim 3 83ER00J0HV Notebook
- Bomba Ár! Lenovo ThinkPad L14 G2a - R5 5600U I 16GB I 256SSD I 14" FHD I Cam I W11 I Gar
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: Central PC számítógép és laptop szerviz - Pécs
Város: Pécs

Fferi50
