- Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- Keringető szivattyú vezérlése: még okosabb fűtés
- Asszociációs játék. :)
- Nagy "hülyétkapokazapróktól" topik
- PLEX: multimédia az egész lakásban
- Fűzzük össze a szavakat :)
- CTEK akkumulátor töltő és másolatai
- Drive! - Az utolsó gurulás idén a Quadrifoglio-val
- Egy korszak vége
- Szólánc.
-
LOGOUT.hu
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
-
djzomby
csendes tag
-
Delila_1
veterán
válasz djzomby #10805 üzenetére
http://prohardver.hu/tema/excel/hsz_5227-5227.html
Itt megtalálod a leírást. Ne zavarjon, hogy régebbi verzióra vonatkozik, a 2007-ben is működik, csak más könyvtárba menti, de ezt önállóan teszi az Excel.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
m.zmrzlina
senior tag
válasz djzomby #10788 üzenetére
Na tudtam, hogy egyszerűbben is lehet ezt.
Másold új modulba a következőt:
Function SZINESÖSSZEG(minta As Range, tartomany As Range)
Dim cella As Range, osszeg As Double
szin = minta.Font.Color
For Each cella In tartomany
If cella.Font.Color = szin Then
osszeg = osszeg + cella.Value
End If
Next cella
SZINESÖSSZEG = osszeg
End FunctionLegjobb ha a personal.xls (personal.xlsb) -be teszed mert akkor minden megnyitott munkafüzetben rendelkezésre fog állni egy SZINESÖSSZEG() nevű új függvény. Úgy használod mint a SZUM() fv-t csak ennek az első paramétere egy olyan abszolút cellahivatkozás (pl: $A$1) amiben ugyanolyan színű karakterek vannak mint amit össze akarsz adni.
Hogy érthetőbb legyen itt egy kép:
Köszönet az ötletért (ki másnak mint) Delila_1-nek
-
m.zmrzlina
senior tag
válasz djzomby #10788 üzenetére
Ilyen kicsi és jól körülhatárolt tartományoknál talán még nem fájóan amatőr megoldás számlálós ciklusra bízni a dolgot:
Sub szinösszeg_v2()
Dim pirososszeg As Single, feketeosszeg As Single
Dim i As Integer, j As Integer, betuszine As Integer
Cells(1, 1).Select
For i = 1 To 10
pirososszeg = 0
feketeosszeg = 0
For j = 1 To 6
betuszine = ActiveCell.Font.ColorIndex
Select Case betuszine 'ha a szöveg színe piros
Case Is = 3 'pirososszeghez aktív cella értékét hozzáadja
pirososszeg = ActiveCell.Value + pirososszeg
Case Is = 1 ''ha a szöveg színe fekete
feketeosszeg = ActiveCell.Value + feketeosszeg 'feketeoszeghez aktív cella értékét hozzáadja
End Select
ActiveCell.Offset(0, 1).Select 'következő cella
Next j
With Range("H" & i) ' sor végére G oszlopba
.Font.ColorIndex = 3 'pirossal
.Value = pirososszeg 'pirososszeget kiír
End With
With Range("G" & i) ' sor végére H oszlopba
.Font.ColorIndex = 1 'feketével
.Value = feketeosszeg 'feketeosszeget kiír
End With
ActiveCell.Offset(1, -6).Select 'vissza a sor elejére
Next i
End SubHa a tartomány változó akkor kötelező, ha a mérete jelentősen megnő akkor érdemes újragondolni a koncepciót.
-
m.zmrzlina
senior tag
válasz djzomby #10786 üzenetére
Van egy szörnyű gyanúm, hogy van erre egyszerűbb megoldás is de több időm erre csak este lesz. Ha addig nem kapsz valami egyszerűbb megoldást akkor használd ezt:
Sub szinosszeg()
Range("A1").Select
Dim pirososszeg As Integer, feketeosszeg As Integer
Dim betuszine As Integer
pirososszeg = 0
feketeosszeg = 0
Do Until ActiveCell.Value = ""
betuszine = ActiveCell.Font.ColorIndex
Select Case betuszine
Case Is = 3
pirososszeg = ActiveCell.Value + pirososszeg
Case Is = 1
feketeosszeg = ActiveCell.Value + feketeosszeg
End Select
ActiveCell.Offset(1, 0).Select
Loop
Range("H2").Value = pirososszeg
Range("G2").Value = feketeosszeg
End Sub -
m.zmrzlina
senior tag
válasz djzomby #10761 üzenetére
Nem tudom honnantól kell elmagyarázni a dolgot (és milyen Excel verziót használsz) de ha jól értem több színű szöveged van és attól függően, hogy milyen színű a szöveged kell különböző dolgokat csinálnia az Excelnek.
Az alábbi makró azt csinálja, hogy I3-tól végigmegy addig amíg van valami az oszlopban és a cella mellé írja a cella szövegének színkódját.
VB-be beilleszteni Insert>Modul menüből lehet
Sub szovegszin()
Range("I3").Select
Dim betuszine As Integer
Do Until ActiveCell.Value = ""
betuszine = ActiveCell.Font.ColorIndex
Select Case betuszine
Case Is = 3 'itt adod meg a szín kódjával, hogy milyen színű szöveg esetén...
ActiveCell.Offset(0, 1).Value = "A szomszédos cella betűszín kódja:" & betuszine 'itt adod meg, hogy mi történjen
Case Is = 4
ActiveCell.Offset(0, 1).Value = "A szomszédos cella betűszín kódja:" & betuszine
Case Is = 5
ActiveCell.Offset(0, 1).Value = "A szomszédos cella betűszín kódja:" & betuszine
Case Is = 6
ActiveCell.Offset(0, 1).Value = "A szomszédos cella betűszín kódja:" & betuszine
Case Is = 7
ActiveCell.Offset(0, 1).Value = "A szomszédos cella betűszín kódja:" & betuszine
Case Is = 8
ActiveCell.Offset(0, 1).Value = "A szomszédos cella betűszín kódja:" & betuszine
End Select
ActiveCell.Offset(1, 0).Select
Loop
End SubA Case Is sorban adod meg hogy milyen szín esetén, a következő sorban pedig hogy mit csináljon a program.
Színekről bővebb információ itt.
Jó lenne több részletet tudni a feladatról mert így csak vaktában lövöldözünk.
Még véletlenül eltaláljuk egymást[ Szerkesztve ]
-
Delila_1
veterán
válasz djzomby #10761 üzenetére
If Range("A1").Font.ColorIndex = 3 Then Range("B1") = "piros"
Ez a sor a B1-be beírja a "piros" szót, ha az A1 karakterei piros színre vannak állítva.
Kiindulásnak biztos elég, ha nem, jelezd.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
Új hozzászólás Aktív témák
- AKCIÓ! Microsoft szoftverek, vírusírtó szoftverek, egyéb szoftverek széles választéka!
- NORTON 360 for Mobile! 1 eszköz, 1 év! DOBOZOS, BONTATLAN!
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Indiana Jones and the Great Circle - Digital Premium Edition - beváltás: 2025.1.30 - RTX 40XX
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest