Új hozzászólás Aktív témák

• #10810 m.zmrzlina senior tag djzomby #10807

  Új Válasz 2011-07-12 12:21:03 #10810

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  m.zmrzlina

  senior tag

  válasz djzomby #10807 üzenetére

  Csak rajta. Itt biztosan kapsz választ.

  

• #10809 Delila_1 veterán djzomby #10808

  Új Válasz 2011-07-12 11:30:38 #10809

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz djzomby #10808 üzenetére

  Szivi.

• #10807 djzomby csendes tag djzomby #10805

  Új Válasz 2011-07-12 11:28:43 #10807

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  djzomby

  csendes tag

  válasz djzomby #10805 üzenetére

  Bazz, egyúttal rá is jöttem....

  az XLSTART mappába kell rakni....

  Nos, igen sokat segítettél m.zmrzlina, leköteleztél.
  Majd biztosan vinnyogok még, mert mindíg olyasmit szeretnék megcsinálni excelben, amire nincs függvény....

  Szép napot.

• #10806 Delila_1 veterán djzomby #10805

  Új Válasz 2011-07-12 11:28:37 #10806

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  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.

• #10803 m.zmrzlina senior tag djzomby #10788

  Új Válasz 2011-07-12 07:47:06 #10803

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  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 Function

  Legjobb 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

• #10797 m.zmrzlina senior tag djzomby #10788

  Új Válasz 2011-07-11 19:36:47 #10797

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  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 Sub

  Ha a tartomány változó akkor kötelező, ha a mérete jelentősen megnő akkor érdemes újragondolni a koncepciót.

• #10795 perfag aktív tag djzomby #10788

  Új Válasz 2011-07-11 17:24:25 #10795

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  perfag

  aktív tag

  válasz djzomby #10788 üzenetére

  "az előző kommentembe a smiley belekavart"
  Ezt elkerülendő használd a Programkód gombot tartomány megadásakor.

• #10787 m.zmrzlina senior tag djzomby #10786

  Új Válasz 2011-07-11 12:06:31 #10787

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  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

• #10765 m.zmrzlina senior tag djzomby #10761

  Új Válasz 2011-07-08 14:50:14 #10765

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  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 Sub

  A 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 ]

• #10764 Delila_1 veterán djzomby #10761

  Új Válasz 2011-07-08 14:15:13 #10764

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  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.

• #10762 ArchElf addikt djzomby #10761

  Új Válasz 2011-07-08 13:56:56 #10762

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  ArchElf

  addikt

  válasz djzomby #10761 üzenetére

  Szerintem próbáld meg használni a keresőt...

  AE

  [ Szerkesztve ]

Új hozzászólás Aktív témák