- Xiaomi 15 - kicsi telefon nagy energiával
- Xiaomi 13T és 13T Pro - nincs tétlenkedés
- One mobilszolgáltatások
- Yettel topik
- Eltűnhet a Dinamikus Sziget
- Samsung Galaxy S23 és S23+ - ami belül van, az számít igazán
- Fotók, videók mobillal
- Samsung Galaxy Watch7 - kötelező kör
- Google Pixel topik
- Xiaomi 13 - felnőni nehéz
-
Mobilarena
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
Hirdetés
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - NYÁRI AKCIÓ!
- Gyermek PC játékok
- Vírusirtó, Antivirus, VPN kulcsok
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- BESZÁMÍTÁS! MSI B460M i5 10400F 16GB DDR4 512GB SSD RX 6650XT 8GB Cooler Master MB600L Chieftec 600W
- ÁRGARANCIA!Épített KomPhone i7 14700KF 32/64GB RAM RX 9070 XT 16GB GAMER PC termékbeszámítással
- Crucial 240GB SSD eladó
- AKCIÓ! MSI B550 R7 5700X 32GB DDR4 512GB SSD RTX 3060Ti 8GB Rampage SHIVA MSI 650W
- Bomba ár! HP EliteBook 840 G2 - i5-5GEN I 8GB I 256GB SSD I 14" HD+ I Cam I W10 I Garancia!
Állásajánlatok
Cég: CAMERA-PRO Hungary Kft
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest