Zaslal/a CMM-Team 27.7.2023 13:51
Dobrý den, nedaří se mi spustit kód, který si myslím, že mám správně umístěný a který by měl reagovat na každou změnu buňky na listu Karta majetku.
Ve VBA mám kód, který by měl po spuštění dohledat ve sloupci B na listu Seznam majetku pořadové číslo a následně doplnit označení majetku, které odpovídá řádku ve kterém našel shodu ,do buňky D6. Bohužel mi kód nereaguje na změny v sešitu. můžete se podívat, kde by mohl být problém ?
Bohužel nejsem schopen přiložit soubor s podporou maker. Prostě se nepřidá, dávám tedy kód sem:
Private Sub Worksheet_Change(ByVal Target As Range)
' Proveď přepočet pouze pokud změna proběhla na listu "Karta majetku" a nebyl již proveden přepočet
If Me.Name = "Karta majetku" And Not Me.Application.EnableEvents Then
Dim wsSeznamMajetku As Worksheet
Set wsSeznamMajetku = ThisWorkbook.Sheets("Seznam majetku")
' Vypnout spouštění událostí, abychom zabránili nekonečnému volání
Application.EnableEvents = False
' Získat hodnotu z buňky D11
Dim searchText As Variant
searchText = Me.Range("D11").Value
' Najít hodnotu buňky D11 na listu "Seznam majetku" ve sloupci B
Dim foundCell As Range
Set foundCell = wsSeznamMajetku.Range("B:B").Find(searchText, LookIn:=xlValues, LookAt:=xlWhole)
' Pokud byla hodnota nalezena, zapsat odpovídající hodnotu ze sloupce J do buňky D6
If Not foundCell Is Nothing Then
Me.Range("D6").Value = foundCell.Offset(0, 8).Value ' Sloupec J (8 sloupců vpravo od sloupce B)
Else
' Pokud hodnota nebyla nalezena, vymazat obsah buňky D6
Me.Range("D6").ClearContents
End If
' Povolit spouštění událostí
Application.EnableEvents = True
End If
End Sub
Děkuji
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.