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

• #28122 Delila_1 veterán marcyman #28121

  Új Válasz 2015-08-17 10:50:15 #28122

  Ú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 marcyman #28121 üzenetére

  Másold a lenti makrót a lapod kódlapjára (lapfülön jobb klikk, Kód megjelenítése, a jobb oldalon kapott üres részbe másold). Lépj vissza a füzetbe, és a G1 cellába írd be az utolsó sor számát, ahol a D oszlopban szám szerepel. A példád szerint ez 23.

  Innen kezdve mikor a B oszlopba új adatot viszel be, a makró kiszámolja, hogy a jelzett cellák összege meghaladja-e a félmilliót. Ha nem, akkor a D oszlopba beírja az NT szöveget. Ellenkező esetben a maradékot, ahogy írtad, a G1-be beviszi az új sorszámot, az E oszlopban elvégzi a cellák összevonását, és beírja oda a következő sorszámot, a példa szerinti 209-et. beírja a C-be a B-D értéket.

  Private Sub Worksheet_Change(ByVal Target As Range)
  Dim osszeg, sor As Long, tartomany As Range
  If Target.Column = 2 And Target.Row > 2 And Target.Count = 1 And Target > "" Then
  Application.EnableEvents = False
  sor = Range("G1")
  Set tartomany = Range("B" & sor + 1 & ":B" & Target.Row)
  osszeg = Cells(sor, "D") + Application.WorksheetFunction.Sum(tartomany)
  If osszeg >= 500000 Then
  Range("D" & Target.Row) = osszeg - 500000
  Range("G1") = Target.Row
  Range("E" & sor + 1) = Application.WorksheetFunction.Max(Columns(5)) + 1
  Range("E" & sor + 1 & ":E" & Target.Row).MergeCells = True
  Range("E" & sor + 1 & ":E" & Target.Row).VerticalAlignment = xlCenter
  Cells(Target.Row, "C") = Cells(Target.Row, "B") - Cells(Target.Row, "D")
  Range("G1") = Target.Row
  Else
  Cells(Target.Row, "D") = "NT"
  End If
  Application.EnableEvents = True
  End If
  End Sub

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