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

• #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.

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