Zobrazení poslední Vyřešeno

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

junis
nováček
Příspěvky: 35
Registrován: březen 22
Pohlaví: Muž

Zobrazení poslední

Příspěvekod junis » 01 srp 2022 19:17

zkouska-excel.xlsm
Šlo by nějak zajistit aby pokud zapíšu hodnotu 1 do nějakého řádku sloupce 3 aby se mi v bunce G3 zobrazila hodnota z tohoto řádku ze sloupce 2. Myslím tím, aby se mi v té buňce G3 zobrazovala vždy jen hodnota ze sloupce 2 buňky kde byla na řádku poslední provedená změna.
Povedlo se mi aby se mi vždy zobrazil čas provedené poslední změny ve sloupci 3 do pole G2. Potřeboval bych vyplnit ještě pole G3

Zapeklitá věc. Díky
Nemáte oprávnění prohlížet přiložené soubory.
Naposledy upravil(a) junis dne 01 srp 2022 20:51, celkem upraveno 3 x.

Reklama
d1amond
člen HW spec týmu
Elite Level 12
Elite Level 12
Příspěvky: 16104
Registrován: květen 08
Bydliště: České Budějovice
Pohlaví: Muž

Re: Zobrazení poslední

Příspěvekod d1amond » 01 srp 2022 20:23

Určitě by bylo namístě, dát sem xlsx s příkladem. Jinak samozřejmě to řešitelné je, ve VBA.
Nikdy neříkej, že to nejde, protože se najde někdo, kdo o tom neví a udělá to!
Chcete si nechat sestavit nový počítač?

junis
nováček
Příspěvky: 35
Registrován: březen 22
Pohlaví: Muž

Re: Zobrazení poslední

Příspěvekod junis » 01 srp 2022 21:00

OK. Přiložil jsem soubor do původního dotazu pro lepší pochopení. Díky

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 331
Registrován: červen 13
Pohlaví: Muž

Re: Zobrazení poslední

Příspěvekod elninoslov » 02 srp 2022 00:42

Ošetruje to vykonávanie pri celom stĺpci ale nie pri hlavičke, ošetruje viacnásobnú zmenu, nesúvislú oblasť, ignoruje inú hodnotu ako 1. Výsledok pre prvú bunku spĺňajúcu podmienky (hoci by ich bolo aj viac)

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Are As Range, Bunka As Range
   
    Set Zmena = Intersect(Columns(3).Resize(Rows.Count - 1).Offset(1, 0), Target)
    If Not Zmena Is Nothing Then
        For Each Are In Zmena.Areas
            For Each Bunka In Are.Cells
                If Bunka.Value = 1 Then
                    Application.EnableEvents = False
                    Cells(2, 7).Resize(2).Value = Application.Transpose(Array(Format$(Now, "dd/mm/yyyy hh:nn:ss"), Bunka.Offset(0, -1).Value))
                    Application.EnableEvents = True
                    Exit Sub
                End If
            Next Bunka
        Next Are
    End If
End Sub

Prípadne si môžete uchovávať aj čas zmeny všetkých doteraz vyplnených 1. Len si budete ukladať ten čas do ďalšieho stĺpca, a nájdete poslednú pomocou vzorcov MAX() a MATCH()/POZVYHLEDAT().
Sem som pridal aj to, že sa pri zmene na inú hodnotu ako 1 (napr. zmazanie 1) bunka s časom vedľa zmaže.

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Are As Range, Bunka As Range, RNG1 As Range, RNG As Range, Cas As Date
   
    Set Zmena = Intersect(Columns(3).Resize(Rows.Count - 1).Offset(1, 0), Target)
    If Not Zmena Is Nothing Then
        Cas = Now()
        For Each Are In Zmena.Areas
            For Each Bunka In Are.Cells
                If Bunka.Value = 1 Then
                    If RNG1 Is Nothing Then Set RNG1 = Bunka.Offset(0, 1) Else Set RNG1 = Union(RNG1, Bunka.Offset(0, 1))
                Else
                    If RNG Is Nothing Then Set RNG = Bunka.Offset(0, 1) Else Set RNG = Union(RNG, Bunka.Offset(0, 1))
                End If
            Next Bunka
        Next Are
       
        Application.EnableEvents = False
        If Not RNG1 Is Nothing Then RNG1.Value = Cas
        If Not RNG Is Nothing Then RNG.ClearContents
        Application.EnableEvents = True
    End If
End Sub


Dodatečně přidáno po 7 hodinách 32 minutách 48 vteřinách:
A ak by ste tých buniek menil naozaj veľa, celý stĺpec a pod., tak by to prechádzanie po jednej bunke trvalo dlho. Potom treba pristúpiť k načítaniu údajov do rýchlejšieho poľa.

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Are As Range, Cas As Date, Vyplnuji(), CasZmeny(), Pocet As Long, i As Long
   
    Set Zmena = Intersect(Columns(3).Resize(Rows.Count - 1).Offset(1, 0), Target)
    If Not Zmena Is Nothing Then
        Cas = Now()
        For Each Are In Zmena.Areas
            Pocet = Are.Cells.Count
            If Pocet = 1 Then
                ReDim Vyplnuji(1 To 1, 1 To 1): Vyplnuji(1, 1) = Are.Value
                ReDim CasZmeny(1 To 1, 1 To 1): CasZmeny(1, 1) = Are.Offset(0, 1).Value
            Else
                Vyplnuji = Are.Value
                CasZmeny = Are.Offset(0, 1).Value
            End If
           
            For i = 1 To Pocet
                CasZmeny(i, 1) = IIf(Vyplnuji(i, 1) = 1, Cas, Empty)
            Next i
           
            Application.EnableEvents = False
            Are.Offset(0, 1).Value = CasZmeny
            Application.EnableEvents = True
        Next Are
    End If
End Sub


Zdá sa Vám to príliš komplikované na takú prkotinu? Vedzte, že ľudia dokážu robiť neskutočné veci v Exceli, a očakávať ešte neskutočnejšie.
Nemáte oprávnění prohlížet přiložené soubory.

junis
nováček
Příspěvky: 35
Registrován: březen 22
Pohlaví: Muž

Re: Zobrazení poslední

Příspěvekod junis » 02 srp 2022 17:12

Fukguje to, chtěl jsem to upravit do připraveného souboru, ale nedaří se mi.
Možná mi s tím pomůžete. Do bílého pole (list Inventura) se načítají nebo zapisují nalezená čísla, z vyhledávacího pole se nalezená označí v (listu Sestava) ve sloupci Q jedničkou. Z listu Sestava se vše kopíruje i do (listu Inventura!!) Do oranžového pole K2 v (listu Inventura) bych potřeboval zobrazovat vždy poslední nalezené číslo z (listu Sestava) slouce N, klidně podle času nalezení který se zobrazuje ve sloupci R.
Přikládám soubor. Měl jsem asi přiložit hned tohle, omlouvám se, ale musel jsem to nějak upravit.
Díky moc
Je to hrozně složité co?
soubor1.zip
Nemáte oprávnění prohlížet přiložené soubory.

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 331
Registrován: červen 13
Pohlaví: Muž

Re: Zobrazení poslední

Příspěvekod elninoslov » 06 srp 2022 02:53

Skúste
Nemáte oprávnění prohlížet přiložené soubory.

junis
nováček
Příspěvky: 35
Registrován: březen 22
Pohlaví: Muž

Re: Zobrazení poslední

Příspěvekod junis » 06 srp 2022 08:35

Do oranžového pole K2 v (listu Inventura) bych potřeboval zobrazovat vždy poslední nalezené číslo z (listu Sestava) slouce N. Ne časovou značku, ale hodnotu, tedy číslo, ze sloupce N z listu sestava. Tedy z vyhledávacího pole.
Jinak ty časy nalezení se již generují do listu sestava, tak v inventuře, jsou zbytečná.

Klidně by stačilo, tuto hodnotu vyvolat kliknutím na tlačítko, vyskočil by MsgBox a zobrazil poslední hodnotu. To by bylo ještě lepší.

Děkuji

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 331
Registrován: červen 13
Pohlaví: Muž

Re: Zobrazení poslední

Příspěvekod elninoslov » 06 srp 2022 20:11

Kód: Vybrat vše

=INDEX(Sestava!N2:N10005;MATCH(MAX(Sestava!R2:R10005);Sestava!R2:R10005;0))
=INDEX(Sestava!N2:N10005;POZVYHLEDAT(MAX(Sestava!R2:R10005);Sestava!R2:R10005;0))

alebo MsgBox

Kód: Vybrat vše

Sub Oznam()
Dim Zaznam As String, Cas As Date

    On Error Resume Next
    With Worksheets("Sestava")
        Cas = WorksheetFunction.Max(.Range("R2:R10005"))
        Zaznam = CStr(.Cells(1 + WorksheetFunction.Match(CDbl(Cas), .Range("R2:R10005").Value2, 0), "N").Value)
    End With
   
    MsgBox IIf(Err.Number = 0, "Poslední záznam :" & vbNewLine & vbNewLine & "Čas" & vbTab & Format(Cas, "d.m.yyyy hh:nn:ss") & vbNewLine & "Záznam" & vbTab & Zaznam, "Žádný záznam")
    On Error GoTo 0
End Sub
Naposledy upravil(a) elninoslov dne 07 srp 2022 12:55, celkem upraveno 1 x.

junis
nováček
Příspěvky: 35
Registrován: březen 22
Pohlaví: Muž

Re: Zobrazení poslední  Vyřešeno

Příspěvekod junis » 07 srp 2022 09:39

A Makrem přes to tlačítko? Díky

Dodatečně přidáno po 3 hodinách 49 minutách 52 vteřinách:
Ano, tohle je přímo super. Děkuji moc za velkou pomoc.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Script: přesunutí souborů do poslední vytvořené složky
    od Grander » 06 bře 2022 18:13 » v Windows 10, 8, 7..
    3
    871
    od zeus
    11 bře 2022 20:31
  • Zobrazení přehrávání
    od sanko33 » 11 led 2022 15:03 » v Vše ostatní (hw)
    1
    461
    od atari
    11 led 2022 17:27
  • úprava zobrazení grafu
    od Fuggas » 10 čer 2022 11:15 » v Kancelářské balíky
    4
    707
    od Martab
    29 črc 2022 17:54

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 1 host