Hirdetés
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Luck Dragon: Asszociációs játék. :)
- sziku69: Szólánc.
- sziku69: Fűzzük össze a szavakat :)
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- Gurulunk, WAZE?!
- ldave: New Game Blitz - 2025
- GoodSpeed: Márkaváltás sok-sok év után
- [K2]: AnyDesk átverés
- Geri Bátyó: Samsung T7 1TB külső SSD
-
LOGOUT
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
-
szatocs1981
aktív tag
Igazából nem nagyon látom át a problémát.
Az segít, ha kiszüröm a kijelölésböl az üres cellákat és avval nem fog történni semmi?Megvan még az eredeti doksi?
EDIT:
Igy a kijelölt cellákból az üreseket békén hagyja:
Sub Makro1()
Dim rng As Range
For Each rng In Selection
sString = rng.Text
If sString <> "" Then
rng.NumberFormat = "@"
rng.Value = sString
End If
Next -
szatocs1981
aktív tag
Szia,
szvsz egy pár soros makróval megoldható a probléma.
A kijelölt cellákat át tudod formázni idöröl szövegre úgy, hogy a cellák tartalma ne változzon.Sub Makro1()
Dim rng As Range
For Each rng In Selection
sString = rng.Text
rng.NumberFormat = "@"
rng.Value = sString
Next
End Sub -
Mutt
senior tag
Hello,
...ha egy fehér munkalapon az egyik cella színét megváltoztatom (pl:sárgára) akkor egy másik munkalapon lévő hivatkozás ne az eredeti értéket vegye alapul, hanem egy előre beállított értéket. (pl: sárga esetén =SZ)
Delila_1 megoldása mellett én is csináltam egy változatot.
Ahogy már olvastad cella színére nincs alapból esemény, ezért valós időben megfogni nem lehet.
Azt választottam, hogy egy ún. volatile függvényt írtam, amely akkor is frissül, ha az érintett cellában nincs változás. Ez azt jelenti, hogy ha vhol módosítasz akkor máris frissül az eredmény.
Az UDF használata:
=ColorDecode(vizsgalando cella;színkód1;eredmény1;színkód2;eredmény2;....)Ahol a színkód pl. fekete, sárga, piros stb. Az eredmény lehet szöveg, másik cella, képlet. Ha nincs találat, akkor az eredei cellát adja vissza.
pl. =ColorDecode(A2;"fekete";-100;"piros";2*2;"zöld";"Z+")
Vagyis ha az A2 színe fekete akkor -100-t ír, ha zöld akkor "Z+"t, sárga esetén pedig az A2 cella értékét.Itt a kód, amelyet te is tudsz bővíteni, csak a színeket és a hozzájuk tartozó kódokat kell felsorolnod. Ezt megkapod, ha csak egy paramétert használsz, pl. ColorDecode(A2)
Function ColorDecode(original As Range, ParamArray contents()) As Variant
Const ColorNum As Integer = 10 'ha 10-nél több szín formázást akarunk
Const ColorNames As String = "FEKETE,SÖTÉTVÖRÖS,PIROS,NARANCS,SÁRGA,VILÁGOSZÖLD,ZÖLD,KÉK,SÖTÉTKÉK,LILA"
Const ColorCodes As String = "0,192,255,49407,65535,5296274,5287936,15773696,6299648,10498160"
Dim vOriginalColor As Long
Dim arrayColors(1 To 2, 1 To 10) 'itt is a 10 javítani, ha fent átírod
Dim i As Integer
Dim s1, s2
Dim blnColorMatch As Boolean
Dim strMatch As String
Dim blnInputMatch As Boolean
'fusson le minden újraszámláláskor
Application.Volatile
'visszadjuk az eredeti értéket, ha nem találunk mást
ColorDecode = original
'az eredeti cella színét megnézzük
vOriginalColor = original.Interior.Color
Select Case UBound(contents)
'ha nincs paraméter akkor kiírjuk a színkódot
Case -1
ColorDecode = "Cella színkódja: " & vOriginalColor
'több paraméter esetén visszatér a megadott értékkel, ha tud
Case Else
'feltöltjük az ismert kódokat tömbbe
s1 = Split(ColorCodes, ",")
s2 = Split(ColorNames, ",")
For i = 1 To ColorNum
arrayColors(1, i) = s1(i - 1)
arrayColors(2, i) = s2(i - 1)
Next i
'megkeressük, hogy ezt a színt ismerjük-e
i = 0
blnColorMatch = False
Do
i = i + 1
If arrayColors(1, i) = vOriginalColor Then
blnColorMatch = True
strMatch = arrayColors(2, i)
End If
Loop Until blnColorMatch Or i = ColorNum
'ha a színt ismerjük, akkor megnézzük, hogy adtak-e rá paramétert
If blnColorMatch Then
blnInputMatch = False
i = 0
Do
'ha megtaláljuk, akkor a kövekező bemeneti paramétert írjuk ki
If strMatch = UCase(contents(i)) Then
ColorDecode = contents(i + 1)
blnInputMatch = True
End If
i = i + 2
Loop Until blnInputMatch Or i > UBound(contents)
End If
End Select
End FunctionBővítésnél a kód elején adj meg egy nevet, majd alatta a kódját. Ha 10-nél több kombinációd van akkor az első konstanst is emeld meg és a Dim arrayColors(1 To 2, 1 To 10) sorban is javítsd a 10-es számot.
üdv.
-
Delila_1
veterán
Mégis sikerült összehozni valamit.
Az első lapon duplaklikkre sárga lesz a háttér, a másodikon az azonos című cella felveszi az SZ értéket.Az első makrót az első laphoz rendeld, a másodikat modulba tedd.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cella$
If Not Intersect(Target, Range("A3:H3")) Is Nothing Then
cella$ = Target.Address
Range(cella$).Interior.ColorIndex = 36
SZ (cella$)
End If
End SubSub SZ(cella$)
Sheets("Munka2").Range(cella$) = "SZ"
End Sub
Új hozzászólás Aktív témák
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Keresem a Barkács Balázs Játékokat
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- MS SQL Server 2016, 2017, 2019
- Surface Pro 7+ i5-1135G7 16GB 512GB 1 év garancia
- Telefon szerviz helyben - Gyors javítás, akár 30 perc alatt!
- ÁRGARANCIA!Épített KomPhone i7 14700KF 32/64GB RAM RTX 5090 32GB GAMER PC termékbeszámítással
- Apple iPhone XR 64GB, Kártyafüggetlen, 1 Év Garanciával
- Apple Imac 21,5 Inch, Late 2015! Intel Core I5 + Intel Iris Pro Graphics. 1TB Háttértár!
Állásajánlatok
Cég: ATW Internet Kft.
Város: Budapest
Cég: BroadBit Hungary Kft.
Város: Budakeszi

Fferi50
