Prosím o úpravu kódu. Děkuji *

[junis]

Dobrý den.
Jak změnit zápis, aby provedl zápis do buněk (doplnění), když bude nějaká hodnota ve sloupci 15 . (Tlačítkem)
Ve sloupci 15 mám vzorec =IFERROR(SVYHLEDAT(J2;datovepole!$C$4:$D$2000;2;NEPRAVDA);"") a doplní mi to jen když do sloupce 15 provedu změnu ručně.
Prostě do sloupce 15 se mi vzorcem zapisují data a já potřebuji pomocí vba zajistit, aby pokud bude v řádku ve sloupci 15 nějaká hodnota mít doplněny buňky vleno viz níže

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Sledovana_oblast As Range
Dim a As Integer
Dim b As Integer

    Set Sledovana_oblast = Range("O4:O2000") 'kontrolované buňky ve sloupci O

         If Not Intersect(Target, Sledovana_oblast) Is Nothing Then
         
            a = Target.Row
       
             With Target(1, -2) 'první řádek slupce K
           
             .Value = Now
           
             .EntireColumn.AutoFit 'automatická šíře sloupce
           
             .Offset(0, -1) = 1
           
             End With
       
         End If
 
End Sub

Chtěl bych to, přepsat to a makro spustit tlačítkem, kdy by se mi pak doplnilo více hodnot na jedno kliknutí

Děkuji pěkně

[Reklama]

[Grimm]

???

Kód: Vybrat vše

Sub Test()

Dim Sledovana_oblast(), Datova_oblast()
Dim i As Integer
With List1      'CodeName listu si případně změň podle svého souboru
    Sledovana_oblast = List1.Range("O4:O2000").Value
    ReDim Datova_oblast(1 To UBound(Sledovana_oblast), 1 To 2)
   
        For i = LBound(Sledovana_oblast) To UBound(Sledovana_oblast)
            If Sledovana_oblast(i, 1) <> "" Then
                Datova_oblast(i, 1) = 1
                Datova_oblast(i, 2) = Now
            End If
        Next i
       
    With .Range("J4")
            .Resize(UBound(Datova_oblast, 1), 2).Value = Datova_oblast
            .Offset(, 1).EntireColumn.AutoFit 'automatická šíře sloupce
    End With
End With
Erase Sledovana_oblast
Erase Datova_oblast
End Sub


[junis]

Ano, děkuji funguje dle požadavku.
Chtěl jsem to použít po úpravách i jinam ale na větší sledovanou oblast než 30000 řádků to nelze.

[Grimm]

Pro příště, bylo by vhodné uvést případnou chybovou hlášku, nebo kde v kódu dojde k chybě než konstatovat - nelze.

Tady bude "zádrhel" v deklaraci proměnné:
Dim i As Integer změn na Dim i As Long

[junis]

"Grimm" přímo perfektní.
Moc a moc děkuju.