Má prísť k vymazaniu len tej frázy alebo všetkého v bunke? Akej oblasti sa to týka? Jednej bunky? Kontrola hneď pri zadávaní vo Worksheet_Change, alebo neskôr jednorázovo na klik tlačítka?citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Vymazání obsahu buňky když obsahuje frázi
MS Excel
Téma: Vymazání obsahu buňky když obsahuje frázi 
Zaslal/a 11.10.2022 12:16
Prosím o radu, když buňka obsahuje určitou frázi, nebo slovo, např "neděle", dojde k jejímu vymazání. Děkuji
(11.10.2022 15:53)#053614
V A1 mám například větu zítra bude neděle. V A2 mám pozítří bude pondělí. V A3 mám Včera neděle byla. A já potřebuju ideálně tlačítkem vymazat celý obsah buněk, které obsahují slovo neděle. V tomto případě tedy A1, A3.citovat
Nástrel. Na konci si vyberte, čo sa má udiať.
Sub Smazat_Bunky_S_Frazi()
Dim Fraze As String
Dim RNG_SMAZ As Range, Oblast As Range
Dim Radku As Long, Sloupcu As Integer, r As Long, s As Integer
Dim D()
Sloupcu = 1
With wsData
Fraze = .Range("C2").Value
If Fraze = "" Then MsgBox "Žádná fráze.", vbExclamation: Exit Sub
Radku = .Cells(Rows.Count, "A").End(xlUp).Row
Set Oblast = .Range("A1").Resize(Radku, Sloupcu)
If Radku + Sloupcu = 2 Then ReDim D(1 To 1, 1 To 1): D(1, 1) = Oblast.Value Else D = Oblast.Value
For r = 1 To Radku
For s = 1 To Sloupcu
If InStr(1, D(r, s), Fraze, vbTextCompare) > 0 Then
If RNG_SMAZ Is Nothing Then Set RNG_SMAZ = Oblast.Cells(r, s) Else Set RNG_SMAZ = Union(RNG_SMAZ, Oblast.Cells(r, s))
End If
Next s
Next r
End With
If RNG_SMAZ Is Nothing Then
MsgBox "Fráze """ & Fraze & """ nebyla v oblasti " & Oblast.Address(0, 0) & " nalezena.", vbInformation
Else
RNG_SMAZ.Select 'pouze označí nalezené
'RNG_SMAZ.ClearContents 'smaže pouze hodnoty, formát a buňky zůstanou
'RNG_SMAZ.Clear 'smaže hodnoty i formáty, buňky zůstanou
'RNG_SMAZ.Delete Shift:=xlUp 'odstraní buňky, zbytek posune nahoru
End If
End Sub
Sub Smazat_Bunky_S_Frazi()
Dim Fraze As String
Dim RNG_SMAZ As Range, Oblast As Range
Dim Radku As Long, Sloupcu As Integer, r As Long, s As Integer
Dim D()
Sloupcu = 1
With wsData
Fraze = .Range("C2").Value
If Fraze = "" Then MsgBox "Žádná fráze.", vbExclamation: Exit Sub
Radku = .Cells(Rows.Count, "A").End(xlUp).Row
Set Oblast = .Range("A1").Resize(Radku, Sloupcu)
If Radku + Sloupcu = 2 Then ReDim D(1 To 1, 1 To 1): D(1, 1) = Oblast.Value Else D = Oblast.Value
For r = 1 To Radku
For s = 1 To Sloupcu
If InStr(1, D(r, s), Fraze, vbTextCompare) > 0 Then
If RNG_SMAZ Is Nothing Then Set RNG_SMAZ = Oblast.Cells(r, s) Else Set RNG_SMAZ = Union(RNG_SMAZ, Oblast.Cells(r, s))
End If
Next s
Next r
End With
If RNG_SMAZ Is Nothing Then
MsgBox "Fráze """ & Fraze & """ nebyla v oblasti " & Oblast.Address(0, 0) & " nalezena.", vbInformation
Else
RNG_SMAZ.Select 'pouze označí nalezené
'RNG_SMAZ.ClearContents 'smaže pouze hodnoty, formát a buňky zůstanou
'RNG_SMAZ.Clear 'smaže hodnoty i formáty, buňky zůstanou
'RNG_SMAZ.Delete Shift:=xlUp 'odstraní buňky, zbytek posune nahoru
End If
End Sub
Příloha: 
53616_najdi-frazu-a-zmaz-bunky.zip (19kB, staženo 7x)
citovat53616_najdi-frazu-a-zmaz-bunky.zip (19kB, staženo 7x)(11.10.2022 19:47)#053618
Elninoslave, prosím mohl byste mi to hodit do nějakého vzoru? Píše mi to chybu a já nevím, co přesně znamená. Děkuji
Fraze = .Range("C2").Valuecitovat
Fraze = .Range("C2").Valuecitovat
Ja niekedy fakt ani neviem, ako mám reagovať. Myslíte do ešte iného vzoru, ako je ten v prílohe stiahnutý 0 krát ?!?!citovat
(12.10.2022 6:16)#053621
Omlouvám se, když jsem viděl ten kód, už jsem moc nekoukal dolů. Funguje perfektně. Moc díkycitovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
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.
RSS nejnovější články