- Yettel topik
- Google Pixel topik
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Vivo X200 Pro - a kétszázát!
- Magisk
- Honor Magic7 Pro - kifinomult, költséges képalkotás
- Samsung Galaxy A56 - megbízható középszerűség
- Telekom mobilszolgáltatások
- Samsung Galaxy S25 - végre van kicsi!
- Okosóra és okoskiegészítő topik
Hirdetés
-
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
-
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? -
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^
#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^
#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?
Új hozzászólás Aktív témák
Hirdetés
Fferi50
- 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
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most kedvező áron!
- 27%-OS ÁFÁS SZÁMLA I Jogtiszta Microsoft digitális és fizikai termékek I DIGITALKEYZ.COM
- Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával - Nint.hu
- Gamer Notebook! Csere-Beszámítás! Asus Rog Strix G731GU! 17,3Col! I7 9750H / GTX 1660Ti / 16GB DDR4
- GYÖNYÖRŰ iPhone 13 256GB Pink -1 ÉV GARANCIA - Kártyafüggetlen, MS3056, 94% Akkumulátor
- Keychrone Q1 V2 billentyűzet / Számla / Garancia /
- HIBÁTLAN iPhone 14 Pro 256GB Deep Purple -1 ÉV GARANCIA - Kártyafüggetlen, MS3014, 91% Akkumulátor
- Epson Expression 12000 XL A3 síkágyas fotószkenner
Állásajánlatok
Cég: FOTC
Város: Budapest