MS Excel

Ahojky.
Potřeboval bych poradit jak vymazat( ne odstranit) řádek ve sloupcích B-K dle hodnoty ve sloupci JK ( podmínka vypsání ANO )a seřazení jednotlivých řádků bez prázdných řádků pouze při znovu otevření sešitu. Řádky se nesmí zrušit (DELETE), ale pouze vymazat v rozsahu B-K.V sloupci JK se může "ANO" opakovat několikrát pod sebou. V ostatních sloupcích jsou vzorce. Používám Excel 2017. Snad je to dosti srozumitelné.

Děkuji za každou odpověď.
Pepča

Zaslat odpověď >

jomo(24.5.2019 11:55)#043398

řešení makrem, kód je pro inspiraci

Sub Makro1()
'
Dim cyklusRadekOd As Long
Dim cyklusRadekDo As Long
Dim radekCislo As Long

cyklusRadekOd = 2
cyklusRadekDo = 20
For radekCislo = cyklusRadekOd To cyklusRadekDo
Range("F" & radekCislo).Select
If Selection.Value = "ANO" Then
Range("A" & radekCislo & ":E" & radekCislo).Select
Selection.ClearContents
End If
Next radekCislo
End Subcitovat

elninoslov(24.5.2019 12:04)#043399

Sub VymazHodnoty()
Dim RNG As Range, JK(), R As Long

With ThisWorkbook.ActiveSheet
R = .Cells(Rows.Count, "JK").End(xlUp).Row
If R = 1 Then
ReDim JK(1 To 1, 1 To 1): JK = .Cells(1, "JK").Value
Else
JK = .Cells(1, "JK").Resize(R).Value
End If

For i = 1 To R
If StrComp(JK(i, 1), "ano", vbTextCompare) = 0 Then
If RNG Is Nothing Then
Set RNG = .Cells(i, 2).Resize(, 10)
Else
Set RNG = Union(RNG, .Cells(i, 2).Resize(, 10))
End If
End If
Next i
End With

If Not RNG Is Nothing Then RNG.ClearContents
End Sub

EDIT: Aha, pozerám, že som si nevšimol požiadavku na zoradenie. Takže, to má byť na základe čoho zoradené ?

Inak, prečo nepoužijete filter ???

Příloha: zip

43399_vymazhodnoty.zip (18kB, staženo 20x)

citovat

elninoslov(24.5.2019 15:07)#043414

Makrom sa to samozrejme dá, ale ak by to bolo možné použil by som radšej filter. Tu je príklad makra, maže a posúva samozrejme aj riadky v JK. Nič zatiaľ nezoraďuje, lebo neviem na základe čoho, iba ich súka pod seba.
Sub VymazHodnoty()
Dim JK(), BK(), V(), VJK(), R As Long, i As Long, VR As Long, y As Byte

With ThisWorkbook.ActiveSheet
R = .Cells(Rows.Count, "B").End(xlUp).Row
If R = 1 Then
ReDim JK(1 To 1, 1 To 1): JK = .Cells(1, "JK").Value
Else
JK = .Cells(1, "JK").Resize(R).Value
End If

BK = .Cells(1, "B").Resize(R, 10).Value
ReDim V(1 To R, 1 To 10)
ReDim VJK(1 To R, 1 To 1)

For i = 1 To R
If StrComp(JK(i, 1), "ano", vbTextCompare) <> 0 Then
VR = VR + 1
For y = 1 To 10
V(VR, y) = BK(i, y)
Next y
VJK(VR, 1) = JK(i, 1)
End If
Next i

.Cells(1, "B").Resize(R, 10).Value = V
.Cells(1, "JK").Resize(R).Value = VJK
End With

End Sub

Příloha: zip

43414_vymazhodnoty.zip (16kB, staženo 21x)

citovat

pepča(25.5.2019 2:26)#043416

Ahojky.

Omlouvám se, že jsem nepřiložil přílohu.

Pepčacitovat

pepča(25.5.2019 2:35)#043417

Bohužel se mi nedaří vložit přílohu je po kompresy stále veliká to jsem již snížil počet řádků na minimum.

Děkuji za pochopení

Pepčacitovat

pepča(25.5.2019 3:03)#043418

Snad již naposled.

Příloha: zip

43418_kniha-predavky-wall2.zip (282kB, staženo 18x)

citovat

elninoslov(26.5.2019 15:01)#043419

Čo chcete robiť s tým makrom "Odemknout" (pôvodný názov "Makro1") ?
To označovanie B12 po každej zmene je nevhodné pri vpisovaní viac nových riadkov - skáče Vám kurzor inde, ako chcete písať.
Mali ste tam obrovské množstvo riadkov a stĺpcov, preto to bol taký veľký súbor.
Premýšľam, či by nebolo vhodnejšie použiť samostatné objekty Tabuľka (ListObject). Celý ten spôsob je taký divný a náchylný k chybe.

Všetko som pozmenil, prezrite...

Příloha: zip

43419_kniha-predavky-wall3.zip (81kB, staženo 25x)

citovat

pepča(27.5.2019 19:32)#043432

Děkuji za vyřešení. V jednoduchosti je dokonalost. Smekám. Prozkoumám vše a snad si již poradím. Sešit musím zamykat a list též, protože jsou tam citlivá data v ostatních listech odkud se tahají jména a osobní data.
Vše musí probíhat automaticky jinak si moji kolegové najdou vždy výmluvy.

Ještě jednou veliké dík.

Jdu se učit a zkoumat.

Pepčacitovat

Téma: Vymazat řádek a seřadit

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje