-
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
-
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
Fferi50- Honda topik
- A cégvezetők látják az AI költségeit, csak azt nem hogyan lesz ebből haszon
- Kormányok / autós szimulátorok topikja
- Futás, futópályák
- Fortnite - Battle Royale & Save the World (PC, XO, PS4, Switch, Mobil)
- Autós topik
- iPhone topik
- Budapest és környéke adok-veszek-beszélgetek
- Kész rémálom lesz Linuxot használni jövőre az USA egyes államaiban
- Bluetooth hangszórók
- További aktív témák...
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Játékkulcsok ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- 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Ó!
- Apple iPhone 14 Pro Max / 128GB / Kártyafüggetlen / 12Hó Garancia / Akku: 87%
- REFURBISHED és ÚJ - DELL Universal Dock UD22 (DisplayLink)
- REFURBISHED - Lenovo ThinkPad 40AF Dock (DisplayLink)
- Acer Chromebase All-in-One PC 23.8" Touchscreen
- BESZÁMÍTÁS! MSI B650 R7 7700 32GB DDR5 1TB SSD RX 9070XT 16GB LIAN LI LANCOOL 217 Wood 750W
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest