-
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
-
mahatma
aktív tag
válasz Dictator^ #1936 üzenetére
ha 3-4 szóval kell müködnie, akkor nálam müködik, a lényeg, hogy jelöld ki az egész munkafüzet tartományát, aztán feltételes formázás, cella értéke legyen egynlő a szóval, aztán pedig hogy mit csináljon vele.
Két hirdetésre jelentkeztem, és mindkét helyen felvettek. Az elsőnek nagyon munkaszaga volt, így a második mellett döntöttem.
-
matekmatika
tag
válasz Dictator^ #1942 üzenetére
Tudod előre mely szavak szerepelnek többször több cellában is, mert az nagyban megkönnyítené a keresést, vagy ezt is a programnak kellene megkeresni. Ez utóbbi esetben, ha hosszabb a szöveg baromira lelassítja a keresést.
Milyen szavakról lenne szó? Pl. magánhangzók szerepelnek-e benne, vagy számok? -
matekmatika
tag
válasz Dictator^ #1951 üzenetére
Hát lehet, hogy rosszul gondolkodom, de ha egy programnak végig kell néznie egy adott területet, hogy van-e egyforma szó, akkor valahogy keresnie kell. Igaz nem neked, hanem a programnak.
A példádat nézve viszont nekem úgy tűnik megsem szavakat kell összehasonlítani, hanem cellákat. Az én eredeti elképzelésem szerint pl. Coca-Cola 3dl és a Coca-Cola 4dl összehasonlítva a Coca-Cola azonos lenne, a 3dl és a 4dl különböző. De neked nem ez kell ezek szerint, hanem hogy az összes Coca-Cola 3dl egy színű legyen illetve az összes Coca-Cola 4dl is csak mondjuk másmilyen színű. Ha jól értem. -
matekmatika
tag
válasz Dictator^ #1954 üzenetére
Visszatérve egy korábbi hozzászólásodra, hogy annyira nem lehet nehéz megcsinálni..., lehet, hogy van akinek nem. Nekem azért kellett vele bírkozni egy kicsit. Nem lehetett volna a tételeket cellánként kezelni?
Itt a végeredmény, hozz létre egy új makrót és illeszd be:
Sub Szinezos()
'Hivatkozni szeretnék majd az aktuális munkalapra
'és mivel nem tudom mi most a neve nálad ezért
'először átnevezem ''Tételek''-re
ActiveSheet.Name = ''Tételek''
'Az utolsó sor száma
sor = ActiveSheet.UsedRange.Rows.Count
'Az utolsó oszlop száma
oszlop = ActiveSheet.UsedRange.Columns.Count
'Alapértelmezett szín
szin = 0
'Létrehozunk egy segéd munkalapot
Worksheets.Add.Name = ''seged''
'melyre a ''seged''-del fogunk hivatkozni
Set seged = Worksheets(''seged'')
'Aktívvá tesszük ismét a Munka1-t
Worksheets(''Tételek'').Activate
x = 0
'Két ciklussal végigmegyünk a cellákon
For j = 1 To oszlop
For i = 1 To sor
'aktuális cella
cella = Cells(i, j)
'cella karaktereinek száma
h = Len(cella)
''',''-t keres a szövegben
a = InStr(cella, '','')
'Ha nincs ''a'' értéke: 0 lesz
'Ha van akkor '','' pozícióját adja
If a > 0 Then
elso = Left(cella, a - 1)
masodik = Right(cella, h - a - 1)
'Ha nem talál '',''-t a beírt szövegben
Else
'Akkor az első legyen maga a cella tartalma
elso = cella
'Második tétel pedig nincs
masodik = 0
End If
'A kapott tételeket eltároljuk a segéd munkalapon
If elso <> Empty Then
x = x + 1
seged.Cells(x, 1) = elso
End If
If masodik <> Empty Then
x = x + 1
seged.Cells(x, 1) = masodik
End If
Next i
Next j
'Tételek átnézése azonosak megjelölése
Application.ScreenUpdating = False
Sheets(''seged'').Select
Columns(''A:A'').Select
Selection.Sort Key1:=Range(''A:A''), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Do While Cells(1, 1) = Empty
Cells(1, 1).Select
Selection.Delete Shift:=xlUp
Loop
a = 2
b = 1
Cells(1, 2) = Cells(1, 1)
Do While Cells(a, 1) <> Empty
If Cells(a + 1, 1) = Cells(b, 2) Then
Cells(b, 3) = Cells(b, 3) + 1
Else
Cells(b + 1, 2) = Cells(a + 1, 1)
Cells(b, 3) = Cells(b, 3) + 1
b = b + 1
End If
a = a + 1
Loop
Sheets(''Tételek'').Select
i = 1
szin = 2
Do While seged.Cells(i, 2) <> Empty
If seged.Cells(i, 3) > 1 Then
For j = 1 To sor
For k = 1 To oszlop
cella = Cells(j, k)
If cella Like ''*'' & seged.Cells(i, 2) & ''*'' Then
kezd = InStr(cella, seged.Cells(i, 2))
hossz = Len(seged.Cells(i, 2))
h = InStr(cella, '','')
If h > 0 Then
With Cells(j, k).Characters(Start:=kezd, Length:=hossz).Font
.FontStyle = ''Félkövér''
.ColorIndex = szin
End With
If Left(cella, h - 1) = Right(cella, Len(cella) - h - 1) Then
With Cells(j, k).Font
.FontStyle = ''Félkövér''
.ColorIndex = szin
End With
End If
Else
With Cells(j, k).Font
.FontStyle = ''Félkövér''
.ColorIndex = szin
End With
End If
End If
Next k
Next j
End If
i = i + 1
szin = szin + 1
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Worksheets(''seged'').Delete
Application.DisplayAlerts = True
End Sub
vagy dolgozd át ezt, itt megnézheted konkrétan mit csinál: [link]
[Szerkesztve] -
matekmatika
tag
válasz Dictator^ #2015 üzenetére
És mi nem tökéletes benne?
Meg most azt írtad a mező színét színezi ki amit találtál. Eddig az volt hogy egy cellán belül több tétel is van és azok más-más színűek legyenek. Most akkor csak szimplán meg kell jelölni azt a cellát amiben egy tétel szerepel máshol is?Kezdem elveszíteni a fonalat
Miért nem linkeled be a táblázatot és akkor talán könyebb lenne megérteni?
Új hozzászólás Aktív témák
- Újabb Samsungok telepíthetik a Galaxy AI-t
- bb0t: Gyilkos szénhidrátok, avagy hogyan fogytam önsanyargatás nélkül 16 kg-ot
- Mindent megtudtunk az új Nokia 3210-ről
- Kerékpárosok, bringások ide!
- Milyen billentyűzetet vegyek?
- Képeken az egyik kameráját elvesztő Sony Xperia 10 VI
- nVidia tulajok OFF topikja
- Vezetékes FÜLhallgatók
- Léghűtés topik
- Érkezik Magyarországa az LG szuper dizájnos hordozható projektora
- További aktív témák...
- Bitdefender Total Security 3év/3eszköz! - "Tökéletes védelem most kedvező áron..."
- Steames kulcsok jó áron eladóak!
- Eladó Steam kulcsok kedvező áron!
- PC JÁTÉKOK (OLCSÓ STEAM, EA , UPLAY KULCSOK ÉS SOKMINDEN MÁS IS 100% GARANCIA )
- Steam, Windows, Origin kulcsok, előfizetések közvetlenül a kiadótól, a LEGJOBB ÁRON!
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: Ozeki Kft.
Város: Debrecen