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

Příspěvky uživatele

A nepotrebujete si tie tabuľky skupín pred zápisom nových, najskôr vymazať? Ak áno môžete to urobiť teda pred každým zápisom poľa Skupiny, alebo jednorázovo na začiatku makra napr.
List4.Range("C2:D20,K2:L20,S2:T20,C22:D40,K22:L40,S22:T40,C42:D60,K42:L60,S42:T60").ClearCOntents
alebo napr výmenou stredu makra za:
ReDim Skupiny(1 To 19, 1 To 2)
Skupiny(1, 1) = Cas(1, 1): Skupiny(1, 2) = Co(1, 1)

For i = 2 To Riadkov
If Co(i, 1) <> Co(i - 1, 1) Then
u = u + 1
Skupiny(u, 1) = Cas(i, 1): Skupiny(u, 2) = Co(i, 1)
End If
Next i

With List4.Cells(2 + Dolu, 3 + VpravoStroj2)
.Resize(19, 2) = Skupiny
.Resize(19).NumberFormat = "h:mm:ss"
End With

kde sa nepoužije dynamické pole, ale statické, čo má za následok zmazanie nevyplnených hodnôt.

Treba lepšie špecifikovať, čo znamená Text1 a Text2. Či sa to nadeklaruje ako konštanta, alebo to má byť počítaný text. Pridal som Vám to tam, prípadne si to rozložte na viac riadkov, alebo do klasického IF THEN, alebo SELECT CASE. Problém ale je, či budú hodnoty skutočne iba 0 a 1. To treba presne špecifikovať, inak to nebude fachať...

Vložte nejakú prílohu pre predstavu...

Hmm. No tak skúste toto. Schválne nepoviem, že sa to ovláda pravým klikom, nepoviem ...

Skúste či na to prídete, ako ...

EDIT: Síce som asi nepochopil o čo vlastne ide, ale tu je teda aspoň návod ako to pracuje:

-pravý klik do C na krúžok aktivuje funkciu vkladania matíc do poľa kde prebiehajú prieniky (I2:BF51)
-opätovným pravým klikom sa deaktivuje umiestňovanie matíc myšou
-ak je umiestňovanie aktívne (čierna gulička), tak pravým klikom do poľa prienikov, sa pole aktualizuje, pričom dochádza aj k zlučovaniu (podľa E - počet buniek v každom smere), aj k vyfarbeniu názvu objektu a obrysu (podľa farby písma v D), zrátaniu prienikov
-prepočítanie funguje aj po stlačení tlačítka (v prípade napr. zmeny parametrov)
-pridanie nového objektu sa robí tak, vypíšete D:G a pravým klikom na C v danom riadku aktivujete umiestňovanie (viď vyššie)

Pr.

EDIT: kolega bol rýchlejší

Toľko buniek by som radšej po jednej nekontroloval (to sú desiatky tisíc). Navrhujem najskôr celú oblasť dať do poľa.
Príklad urobený tak, že sa pri každej aktivácii listu, ktorý nieje vo výnimkách (viď makro), aktualizuje zoznam skupín na danom liste.

Ešte raz. Čože to má určiť, čo je jedinečná hodnota a čo nie ???

???

PRZ10.CAPTION = SHEETS("1").CELLS(14,X)
X=0 teda chyba...

Premýšľal som nad tým chvíľu, ale keďže som nenašiel parameter v SpecialCells, ktorý by mi na to sedel, tak som od toho upustil...

Function NajdiVsetky(Co As String, Kde As Range) As Range
Dim Bunka As Range, Prva As String
Set Bunka = Kde.Find(What:=Co, LookIn:=xlValues, lookAt:=xlPart)

If Not Bunka Is Nothing Then
Prva = Bunka.Address
Set NajdiVsetky = Bunka

Do Until Bunka Is Nothing
Set NajdiVsetky = Union(NajdiVsetky, Bunka)
Set Bunka = Kde.FindNext(Bunka)
If Bunka.Address = Prva Then Exit Do
Loop
End If

Set Bunka = Nothing
End Function

Sub VasaProcedúra()
Dim Vsetky As Range
Set Vsetky = NajdiVsetky("*ab*", Worksheets("Hárok1").Range("A1:C4"))
If Not Vsetky Is Nothing Then Vsetky.Select

'Nejaká činnosť

Set Vsetky = Nothing
End Sub

Alebo 2 definované názvy a jeden riadok kódu.

A na to Vám nestačí obyčajný vzorec ?
=MID(A2;FIND("=";A2)+2;LEN(A2))&"="&LEFT(A2;FIND("=";A2)-2)
=ČÁST(A2;NAJÍT("=";A2)+2;DÉLKA(A2))&"="&ZLEVA(A2;NAJÍT("=";A2)-2)

A kde ste nechal indexovacie (poradové) čísla, na základe ktorých to fachalo, ktoré Vám tam mepexg nachystal ? Ja tam vidím nejaký číselný bordel. Alebo si počítate poradový index odpočtom riadkov+násobok stĺpcov? V tom bude problém.

PS: Inak príloha sa nahrá iba tak, že ju zabalíte do ZIP, RAR, alebo premenujete na ZIP. Priamo XLS sem nejde nahrať.

EDIT: Aha, pozrite si a nastavte oblasť tlače (napr v Definovaných názvoch / Správca názvov)

Z brucha : na konci pripočítajte 1
...
maxRadek2 = List2.Cells(Rows.Count, 4).End(xlUp).Row + 1
...

EDIT:
Respektíve, keď na to pozerám, tak fakt od brucha, tak by to malo byť plus mínus autobus takto:
...
x = 1
maxRadek = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
maxRadek2 = List2.Cells(Rows.Count, 4).End(xlUp).Row

For i = 1 To maxRadek
If ActiveSheet.Cells(i, 4).Value = "Hotovo" Then
ActiveSheet.Rows(i).EntireRow.Copy List2.Rows(maxRadek2 + x)
x = x + 1
End If
Next i
...
ale neskúšam to, to len tak ...

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse