Výsledky výpočtu v excelu na nový řádek

[patrik_k]

Dobrý den, potřeboval bych poradit, jak dostávat podle zadání výsledky výpočtu (součtu) do příslušné buňky (buněk). Tzn. zadání č.5 (tj. buňka B1 a hodnota 5) dostat do buňky E6 a výsledek (buňka B4) tj. 22 do buňky F6, atd. zadání č.6 dostat do buňky E7 a výsledek pak do buňky F7(atd.)? Poradí mi někdo?

[navstevnik]

Vzhledem k nutnosti zachovat vysledky predchozich zadani, je resenim procedura ve VBA.
V udalostni procedure Worksheet_Change cislo zadani bude urcovat polohu vysledku ve sloupcich E:F.
Tolik porada, pokud v rozumnem case nedospejes k reseni, dej sem vedet, pridam dalsi pomoc.
Doplnuji: udalostni procedura by vyzadovala vlozit cislo zadani az nakonec (jinak nutno osetrit postup zadavani), tak je vhodnejsi resit subrutinou volanou klavesovou zkratkou.

[navstevnik]

a student ma domaci ukol vyresen.
Subrutina volat klavesovou zkratkou:

Kód: Vybrat vše

Option Explicit
Public Zadani As Range
Sub ZadaniVysledek()
Dim Vysledek As Range
  Set Zadani = Worksheets("list1").Range("b1")
  Set Vysledek = Zadani.Offset(0, 3)
  Vysledek.Offset(Int(Zadani.Value), 0).Value = Int(Zadani.Value)
  Vysledek.Offset(Int(Zadani.Value), 1).Value = Zadani.Offset(3, 0).Value
  Zadani.Resize(3, 1).ClearContents
End Sub

a pripadne volat: udalostni procedurou (nutno vlozit cislo zadani nakonec):

Kód: Vybrat vše

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  Set Zadani = Worksheets("list1").Range("b1")
  If Target.Address = "$B$1" And Int(Zadani.Value) > 0 Then
    Application.EnableEvents = False
    ZadaniVysledek
    Application.EnableEvents = True
  End If
End Sub

[mike007]

navstevnik: Myslím, že v té událostní proceduře máš chybu. Jinak máš to lépe provedené než já, takže své řešení mažu, ať to je zde přehledné.

[navstevnik]

mike007: Chyba v udalostni procedure neni, ale vzdy lze dopilovat, takze (a proto predchozi nemazu):

subrutina:

Kód: Vybrat vše

Option Explicit
Sub ZadaniVysledek()
Dim Zadani As Range, ZadCis As Integer, Vysledek As Range
  Set Zadani = Worksheets("list1").Range("b1")
  If Not IsNumeric(Zadani.Value) Or Zadani.Value = 0 Then Exit Sub
  ZadCis = Int(Zadani.Value)
  Set Vysledek = Zadani.Offset(0, 3)
  Vysledek.Offset(ZadCis, 0).Value = ZadCis
  Vysledek.Offset(ZadCis, 1).Value = Zadani.Offset(3, 0).Value
  Zadani.Resize(3, 1).ClearContents
End Sub

udalostni procedura:

Kód: Vybrat vše

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$1" Then
    Application.EnableEvents = False
    ZadaniVysledek
    Application.EnableEvents = True
  End If
End Sub

[mike007]

Chyba tam není, ale je dost nepraktické zadávat údaje odzdola nahoru

[navstevnik]

mike007: mas pravdu, a protoze s nejvetsi pravdepodobnosti se jedna o skolni zadani, nebot to nema prakticke uplatneni (patrik_k stejny dotaz dal na http://excelplus.net./forum), muze vlastni pili upravit pro bunku B3.

[mike007]

Pravda
Označuju "problém" za vyřešený.