• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Challenge - odstranění sloupců s podmínkou

Zaslal/a eLCHa 3.12.2015 7:22

Jen tak z legrace

Odstraňte všechny celé sloupce, které mají v prvním řádku číslo 10.

Kód nesmí obsahovat více než 2 řádky.

With, End With se nepočítá jako řádek
With BlaBla
.BlaBla
End With= 1 řádek

Použití dvojtečky se považuje za ukončení řádku BlaBla:BlaBla= 2 řádky


Doplnění na základě dotazů:
V prvním řádku můžou být jakákoliv čísla (nejen 1 až 10) nebo prázdné buňky.
10 se musí vyskytovat.

Kdo si chce zapřemýšlet, tak hned neklikejte na druhou stranu, kde je řešení.

Příloha: 28487_1-10.zip (5kB, staženo 15x)

Zaslat odpověď >

---

Strana:  « předchozí  1 2 3 4   další »

xlnc(3.12.2015 14:53)#028510

"nedesítkový" myslím cokoliv číselného v prvním řádku, co není 10 :-)

A propos With..End With je sice v uvedeném zadání jakože jeden řádek, ale jeho použití je v příkladu nesmyslné, takže v praxi je With..End With přinejmenším "dvouřádkový", protože k jednomu objektu a jeho vlastnostem přistupujeme nejméně dvakrát.citovat

marjankaj(3.12.2015 14:56)#028511

No na rekurziu by to išlo aj takto. Skončí to síce chybou, ale zadanie splní.
Sub rekur()
Columns(WorksheetFunction.Match(10, Range("1:1"), 0)).Delete
Call rekur
End Subcitovat

eLCHa(3.12.2015 20:20)#028513

Moje první řešení bylo právě pomocí Evaluate With Range(Range("A1"), Range("A1").End(xlToRight))
.Value = Evaluate("IF(" & .Address & "=10,NA()," & .Address & ")")
.SpecialCells(xlCellTypeConstants, xlErrors).EntireColumn.Delete
End With 'Range(Range("A1"), Range("A1").End(xlToRight))
Tady zároveň ukazuji, jak jsem to myslel s tím With ;) .
Tato varianta ale nevyhovuje, protože nahrazuje prázdné buňky 0.

aha - takže jednořádkové řešení se týká toho konkrétního zadání nebo jakéhokoliv?
Tak nějak Vám vracím Vaš otázky ;)))citovat

xlnc(3.12.2015 20:34)#028514

Pro Evaluate jsem myslel spíš něco jako:
=SMALL((Data=10)*SLOUPEC(Data);SLOUPEC()+COUNTIF(Data;"<>10"))citovat

eLCHa(4.12.2015 6:24)#028515

Tak mám hotovou jednořádkovou verzi pro mé (tedy původní) zadání ;))

Je to jednoduché - tady je nápověda:
1. transponovat
2. transponovat
3. vyfiltrovat
4. spojit
5. nahradit
6. předělat
7. odstranit

To by Vás mohlo navést citovat

eLCHa(4.12.2015 7:05)#028516

Ještě mně něco napadlo, tak jsem to vyzkoušel.

Pokud se rozhodnete pracovat s celým prvním řádkem, můžete vynechat kroky 1 a 2


V extrému jsem se dostal na 140 znaků a už se musím věnovat něčemu serióznímu ;))citovat

eLCHa(4.12.2015 8:30)#028517

Tak mně napadlo další řešení v souvislosti s tou rekurzí (@marjankaj - stačilo ošetřit a nekončilo by chybou a zadání by splnilo, viz níže) a to využití specifické vlastnosti basicu:10 Columns(WorksheetFunction.Match(10, Range("1:1"), 0)).Delete
20 If WorksheetFunction.CountIf(Rows(1), 10) > 0 Then GoTo 10
Takže je to cyklus a je na 2 řádky. Stejně by šel využít klasický label (ten už ale zadání nesplňuje):lblDel: Columns(WorksheetFunction.Match(10, Range("1:1"), 0)).Delete
If WorksheetFunction.CountIf(Rows(1), 10) > 0 Then GoTo lblDel
Takže můžete klidně přemýšlet dále...citovat

xlnc(4.12.2015 10:54)#028523

Já už na to taky nemám zatím čas :-) Jestliže se nějak povedlo pracovat s transpozicí (na poli), tak fajn.

Tak si ještě dejte to nedesítkové zadání :-) Je to jednoduché :-) Využívá jedné věci (v dialogu, potažmo VBA), kterou nikdo (včetně mě) nepoužívá.

Jednořádkové If..Then, případně nebezpečná IIf.. no, jeden řádek, krok jeden nebo dva? Je pravda, že takhle asi nejde uvažovat, protože každá tečka taky značí defakto jeden krok.citovat

marjankaj(4.12.2015 10:58)#028524

No ak by ten LABEL bol prekážkou, tak takto
Sub aaa()
Columns(WorksheetFunction.Match(10, Range("1:1"), 0)).Delete
If WorksheetFunction.CountIf(Rows(1), 10) > 0 Then Call aaa
End Sub

Úplne blbuvzdorné to nie je. Ak v riadku nebude žiadna hodnota 10, tak to skončí chybou.citovat

eLCHa(4.12.2015 12:29)#028525

@marjankaj
To nevadí - v zadání je (doplněno pod čarou), že tam nějaká být musí.

@xlnc
Asi to budete muset vložit. Už se nějak nesoustředím Nakonec bych to stejně udělal nějak podobně jako toto.

@ALL
Tady je mé jednořádkové řešení:
1. varianta: With Range(Range("A1"), ActiveSheet.UsedRange.EntireColumn).Rows(1)
Range(Application.ConvertFormula(Replace(Join(Filter(Evaluate("=TRANSPOSE(TRANSPOSE(" & .Address & ")&""#|_C""&ROW(1:" & .Columns.Count & "))"), "10#|_"), ","), "10#|_", vbNullString), xlR1C1, xlA1, True)).Delete
End With 'Range(Range("A1"), ActiveSheet.UsedRange.EntireColumn).Rows(1)

2. varianta - pracuje s celým řádkem a tak nepotřebuje transpozice: With ActiveSheet.Rows(1)
Range(Application.ConvertFormula(Replace(Join(Filter(Evaluate("=" & .Address & "&""#|_C""&COLUMN(1:" & .Columns.Count & ")"), "10#|_"), ","), "10#|_", vbNullString), xlR1C1, xlA1, True)).Delete
End With 'ActiveSheet.Rows(1)

No a nakonec - co nejkratší řešení (E007 a novější - pro starší by mělo stačit nahradit počet sloupců):Range(Application.ConvertFormula(Replace(Join(Filter(Evaluate("1:1&""#C""&COLUMN(1:16384)"), "10#"), ","), "10#", ""), xlR1C1, xlA1)).Deletecitovat

Strana:  « předchozí  1 2 3 4   další »

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse