Makro při změně hodnoty v bunce,úprava vzorce Vyřešeno

[esi32]

Dobrý den,
opět bych potřeboval Vaši pomoc.Potřebuji vyhodnotit klienta na listě Evidence faktur,jestli zaplatil,nebo ne.Pokud bude vyhodnocen jako neplatič,potřeboval bych,aby se automaticky nakopírovala jeho data do prvního prázdného řádku na dalším listě Seznam neplatičů.Kopírování by mělo proběhnout v okamžiku,kdy se v bunce Q objeví slovo neplatič.Druhý problém mám se vzorcem,který mi vypisuje u klientů,kteří ještě nemají např.vystavenou fakturu,číslo 41069.To mi tam dělá paseku a potřeboval bych to odstranit.
V vzorovém sešitě jsem se snažil problém popsat.Když bude potřeba,tak se budu snažit vysvětlit dodatečně.
Děkuji za případnou pomoc a řešení..

[Reklama]

[pavel.lasak]

Pokud dobře chápu - stavy faktury tedy budou:
- zaplacena
- čeká na zaplacení (buď odeslání, nebo je čas než bude zaplaceno)
- nezaplacená (zpoždění v placení)

[cmuch]

Tak chyba ve vzorci =KDYŽ(JE.CHYBHODN($L$1-F3);"";$L$1-F3) ve sloupci D není.
Nahradil bych ho tímto =KDYŽ(($L$1-F3)>41000;"";$L$1-F3). Kde 41000 je den po 1.1.1900.

To nakopírování by probíhalo kdy?
Po aktivaci listu SeznamNeplatičů nebo kdy?
Probíhalo by tak že by se načetla oblast na listu EvidenceFaktur slopuce Q a kde by bylo Neplatič tak by se zkopirovali udaje.

Nebo napadne někoho něco jiného.

Edit\\
pavel.lasak měl rychlejší odpověď.

[esi32]

Děkuji za odezvu,
to: pavel.lasak:Ano,přesně jak říkate.
to:cmuch:to kopírování jsem myslel,že by se to překopírovalo v okamžiku,kdy se ve sloupci Q na jakémkoliv řádku objeví "Neplatič".Ale necham to na Vás.Asi podle obtížnosti.

[cmuch]

Tak asi esi32 takto.
Nahradil bych vzorec ve sloupci P tímto =KDYŽ(A(H2<>"";H2>0;J2="Nežádá");"Neplatič";"") a zrušil bych sloupec Q.
A toto makro vložil na list SeznamNeplatičů:

Kód: Vybrat vše

Option Explicit

'provede se pri aktivaci listu
Private Sub Worksheet_Activate()

  'definovani promennych
  Dim BlkA As Range
  Dim CllA As Range
  Dim radek As Integer
 
  'definovani bloku bunek na listu ve sloupci P
  With Worksheets("EvidenceFaktur")
    Set BlkA = .Range(("p2:p") & .Cells(Rows.Count, "p").End(xlUp).Row)
  End With
 
  'smazani dat ve sloupcich A, B
  Sheets("SeznamNeplatièù").Columns("A:B").ClearContents
 
  'vypne aktualizaci obrazovky
  Application.ScreenUpdating = False

    'prochazet jednotlive bunky v bloku BlkA
    For Each CllA In BlkA.Cells
       
        'jestlize bude v bunce "Neplatic" tak proved jinak preskoc
        If CllA.Value = "Neplatiè" Then
       
          'nalezeni prvniho prazdneho radku na listu
          'nakopirovani dat
          With Sheets("SeznamNeplatièù")
            radek = .Range("A1").CurrentRegion.Rows.Count + 1
                 
            .Cells(radek, "A") = CllA.Offset(0, -15).Value
            .Cells(radek, "B") = CllA.Offset(0, -14).Value
          End With
        End If
    Next CllA

  'zapne aktualizaci obrazovky
  Application.ScreenUpdating = True

  ' odstranit objektove promenne
  Set CllA = Nothing
  Set BlkA = Nothing

End Sub

[esi32]

Zdravím asi takto,Cmuch
je to super,funguje jak má..Kdybys měl chvilku,mohl bys mi to makro trochu popsat?Zas bych byl o něco chytřejší.Když to pochopim,tak bych si chtěl zkusit makro upravit,aby mi to samé dělalo ještě s jiným řádkem.
Ještě jednou moc děkuju za pomoc a hlavně za ochotu.Dík.

[cmuch]

Tak jsem doplnil popisky do makra v předchozím příspěvku.
Dofám, že je to dostačující.

[esi32]

Tak popis trošku pomohl a tak to zkouším,ale asi jsem někde trošku mimo.

Kód: Vybrat vše

 Private Sub Worksheet_Activate()

  Dim BlkA As Range
  Dim CllA As Range
  Dim radek As Integer
 
  ' definovani bloku bunek na listu
  With Worksheets("EvidenceFaktur")
    Set BlkA = .Range(("p2:p") & .Cells(Rows.Count, "p").End(xlUp).Row)
  End With
  ' priprava
    Sheets("Neplatiči").Columns("A:B").ClearContents
 
Application.ScreenUpdating = False

    ' prochazet BlkA
    For Each CllA In BlkA.Cells
       
        If CllA.Value = "Neplatič" Then
       
          With Sheets("Neplatiči")
            radek = .Range("A1").CurrentRegion.Rows.Count + 1
                 
            .Cells(radek, "A") = CllA.Offset(0, -15).Value
            .Cells(radek, "B") = CllA.Offset(0, -14).Value
          End With
        End If
    Next CllA
     
Application.ScreenUpdating = True


  ' odstranit objektove promenne
  Set CllA = Nothing
  Set BlkA = Nothing
  '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++oDKLAD-VYMAZAT?
Dim BlkB As Range
  Dim CllB As Range
  Dim radek As Integer
 
  ' definovani bloku bunek na listu
  With Worksheets("EvidenceFaktur")
    Set BlkA = .Range(("q2:q") & .Cells(Rows.Count, "q").End(xlUp).Row)
  End With
  ' priprava
    Sheets("List2").Columns("A:B").ClearContents
 
Application.ScreenUpdating = False

    ' prochazet BlkA
    For Each CllB In BlkA.Cells
       
        If CllB.Value = "Odklad splátky" Then
       
          With Sheets("List2")
            radek = .Range("A1").CurrentRegion.Rows.Count + 1
                 
            .Cells(radek, "A") = CllA.Offset(0, -15).Value
            .Cells(radek, "B") = CllA.Offset(0, -14).Value
          End With
        End If
    Next CllB
     
Application.ScreenUpdating = True
Set CllB = Nothing
  Set BlkB = Nothing
  '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++oDKLAD-VYMAZAT?

End Sub


Zastaví se mi to na tom druhém Dim AS Integrer-chyba dvojitá deklarace.
Co mam blbě?

--- Doplnění předchozího příspěvku (11 Čer 2012 18:22) ---

Tož vyřešeno.Dík za pomoc a ochotu.