• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Fórum

Příspěvky uživatele

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 ...

Nočný nástrel pred spaním. Dve verzie. Jedna kopíruje celé riadky (teda aj formát), druhá len hodnoty. Príliš som to netestoval...

pr.

EDIT: Aha, tak kolega bol rýchlejší. KT bude vhodnejšia, aj keď budete potrebovať vypísať neznámy počet neznámych produktov...

Niečo podobné:
Sub Send()
Dim RNG As Range, PIC As Picture, OUT As Object, OUTMAIL As Object, WRDDOC As Object
Set RNG = Range("B2:J87")
RNG.Copy

Set PIC = ActiveSheet.Pictures.Paste
PIC.Cut

Set OUT = CreateObject("Outlook.Application")
Set OUTMAIL = OUT.CreateItem(olMailItem)
With OUTMAIL
.To = "halusky@portal.sk"
.CC = "slize@portal.sk"
.Subject = "Pozdrav z Marsu"
End With
OUTMAIL.Display

Set WRDDOC = OUTMAIL.GetInspector.WordEditor
WRDDOC.Range.PasteSpecial , , , , wdPasteBitmap

Set WRDDOC = Nothing: Set OUTMAIL = Nothing: Set PIC = Nothing: Set OUT = Nothing: Set RNG = Nothing
End Sub

Treba zafajknúť v Tool-References
Microsoft Outlook 16.0 Object Library
Microsoft Word 16.0 Object Library

Problém ale spočíva ešte v nutnosti potvrdiť v Outlooku vytvorenie správy. SendKeys sa mi nepodarilo rozbehať.

??? Nesatačí ???
=COUNTIF(oblasť;"meno")

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

Formulář Faktura

Helios iNuvio

On-line nástroje