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

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

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