To môže byť veľa riešení. Tu som si napr. pomohol CHOOSE, MATCH, OFFSET, IFERROR (ZVOLIT, POZVYHLEDAT, POSUN, CHYBHODN) ... a podmienené formátovanie
Takto by ste si napr mohli vypočítať oblasť rozsahu (môžu byť medzi tým prázdne riadky):
{A1:INDEX(A1:A1000;MAX(NOT(ISBLANK(A1:A1000))*ROW(A1:A1000)))}
{A1:INDEX(A1:A1000;MAX(NE(JE.PRÁZDNÉ(A1:A1000))*ŘÁDEK(A1:A1000)))}
dajte to do SUM/SUMA
{SUM(A1:INDEX(A1:A1000;MAX(NOT(ISBLANK(A1:A1000))*ROW(A1:A1000))))}
{SUMA(A1:INDEX(A1:A1000;MAX(NE(JE.PRÁZDNÉ(A1:A1000))*ŘÁDEK(A1:A1000))))}
alebo do SUMIFS, tu nepoznám Vaše podmienky, preto aby Vás vzorec nemýlil, tak si Výpočet rozsahu dajte do definovanej oblasti "RNG"
=$A$1:INDEX($A$1:$A$1000;MAX(NOT(ISBLANK($A$1:$A$1000))*ROW($A$1:$A$1000)))
=$A$1:INDEX($A$1:$A$1000;MAX(NE(JE.PRÁZDNÉ($A$1:$A$1000))*ŘÁDEK($A$1:$A$1000)))
a SUMIFS napr
{=SUMIFS(RNG;RNG;"<>"&88)}
To je len úvaha/tip, netuším Vaše použitie. Pozor na to, je to maticový vzorec Ctrl+Shift+Enter)
Ale najlepšia bude Tabuľka - objekt.
A aký vplyv má mať na zelené/červené v C10:I10, ten riadok OK/NG ?
EDIT: Ak musí byť splnené to, že musia byť zelené všetky hodnoty a zároveň posledné musí byť OK, tak napr. takto
Na víkend som si naplánoval jeden deň voľno, tak keď mi to vyjde, môžem sa Vám na to mrknúť. Nič ale nesľubujem...
-V prvom rade si pozrite, či nemáte zlé adresovanie názvu listov.
-Ak máte podozrenie, že Vám nejaké makro mení bunky, v danom liste si dajte BreakPoint do OnChange, a ďalej krokujte, aby ste videli, kam sa vráti.
-Ak používate globálne makro pre celý zošiť, pozrite či nemá tento list svoje makro v metóde onchange, lebo to je nadradené globálnemu.
Napr.
Je to vždy 90% z predošlého čísla. Čiže násobiť 0,9.
Takže si do dajte
A1 = 1000
A2 = A1*0,9
bunku A2 potiahnite koľko potrebujete.
Tak to Vás sklamem. Nič nezabráni úprave, ak dotyčný chce a má snahu či nejaký úmysel, o to očividne má. Tak ako to Vy prevediete na obrázky, tak si to on prevedie späť na text pomocou OCR.
S prevodom na obr. ale skúsenosť nemám...
Zadajte do Google "pdf unlocker" a hneď 1. odkaz je free online unlocker.
@ spitffire: Títo 2 páni by Vám to asi urobili peknejšie, ale toto máte odo mňa na dobrú noc :)
Sub Copy_1_To_3_Columns()
Dim P, D(), x As Integer, y As Long, r As Long, s As Integer
With Worksheets("List1")
r = .Cells(Rows.Count, 1).End(xlUp).Row
P = .Cells(1, 1).Resize(r)
End With
s = r \ 3
ReDim D(1 To s + 1, 1 To 3)
For y = 0 To s
For x = 1 To 3
If (y * 3) + x <= r Then D(y + 1, x) = P((y * 3) + x, 1)
Next x
Next y
With Worksheets("List2")
.Columns(1).ClearContents
.Cells(1, 1).Resize(s + 1, 3).Value = D
End With
End Sub
Čo prosím ? Ak myslíte úvodzovky ktoré ohraničujú textový reťazec, tie tam v skutočnosti niesú, to len symbolizuje že hodnota je reťazec. Ak reťazec skutočne obsahuje uvodzovky tak ich uvedený príkaz musí odstrániť. Vyskúšajte, čo Vám dá
ASC(Left(nazev, 1))
Akurát som našiel jeden kódik, už ho sem dám...
Private Sub SaveRngAsJPG(Rng As Range, FileName As String)
Dim Cht As Chart, bScreen As Boolean, Shp As Shape
bScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
Set Cht = Workbooks.Add(xlChart).Charts(1)
Cht.ChartArea.Clear
Rng.CopyPicture xlScreen, xlPicture
Cht.Paste
With Cht.Shapes(1)
.Left = 0
.Top = 0
.Width = Cht.ChartArea.Width
.Height = Cht.ChartArea.Height
End With
Cht.Export FileName, "JPEG", False
Cht.Parent.Close False
Application.ScreenUpdating = bScreen
End Sub
Sub TestIt2()
Dim Rng As Range, Fn As String
Set Rng = ThisWorkbook.Worksheets("Hárok1").Range("A1:D3")
Fn = "d:\MyFile.jpg"
SaveRngAsJPG Rng, Fn
End Sub
PS: Vo Win8 sú problematické práva pre disk C, ukladajte radšej inde. Bolo by treba ale ešte doriešiť nastavovanie rozmerov, bo malé rozsahy sú deformované.
EDIT: @tarantula222 : Tieto kódy sú nespoľahlivé. Aj ten Váš mi zastaví na
.Pictures.Paste.Select
Ak dám pokračovať, pekne dobehne...
AU
Wiki : 149597870700000 mm
Google : 149600000000000 mm
To vozítko Google to zase odfláklo.
stočtyřicetdevět=bilionů=pětsetdevadesátsedm=miliard=osmsetsedmdesát=milionů=sedmset=tisíc=milimetrů
Keď do toho ale vnesieme, že je to iba priemerná vzdialenosť, a šábneme to zakrivením časopriestoru, no ... niekto to bude musieť premerať mikrometrom
Toto Vám urobí hromadné kopírovanie viac obrázkov naraz. Nastavenie pozície sa už potom musí logicky robiť samostatne. Či je to rýchlejšie alebo nie, neviem, rýchlosť som netestoval ...
Sub Obrazky3()
Dim Img() As String, Data(), Vyber() As Integer, i As Integer, a As Integer, r As Integer, Pocet As Integer
With Sheets("Sekce")
Data = .Cells(4, 24).Resize(41, 5).Value
Pocet = WorksheetFunction.CountIf(.Range("X4:X44"), "<>" & "")
End With
ReDim Img(1 To Pocet): ReDim Vyber(1 To Pocet)
Application.ScreenUpdating = False
On Error Resume Next
For i = 4 To 44
If Not IsEmpty(Data(i - 3, 1)) Then
a = a + 1: Img(a) = Data(i - 3, 2): Vyber(a) = i - 3
End If
Next i
Sheets("Sekce").OLEObjects.Item(Img).Copy
With Sheets("Skladba jednotky")
.Paste
a = .OLEObjects.Count
For i = a - Pocet + 1 To a
r = i - (a - Pocet)
With .OLEObjects(i)
.Top = Data(Vyber(r), 3)
.Left = Data(Vyber(r), 4)
.Name = Data(Vyber(r), 5)
End With
Next i
End With
If Err Then MsgBox ("Počas operácie nastala chyba.")
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub Obrazky()
Dim Data()
Data = Sheets("Sekce").Cells(4, 24).Resize(41, 5).Value
Application.ScreenUpdating = False
On Error Resume Next
With Sheets("Skladba jednotky")
For i = 4 To 44
If Not IsEmpty(Data(i - 3, 1)) Then
Sheets("Sekce").OLEObjects.Item(Data(i - 3, 2)).Copy
.Paste
With .OLEObjects(.OLEObjects.Count)
.Top = Data(i - 3, 3)
.Left = Data(i - 3, 4)
.Name = Data(i - 3, 5)
End With
End If
Next i
End With
If Err Then MsgBox ("Počas operácie nastala chyba.")
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Koľko sa Vám ich naraz väčšinou kopíruje? Rozmýšľam, či by sa to nedalo hromadne kopírovať, či by sa neušetril nejaký čas ...
V dokonalom svete by ocinko mohol napr dostať riešenie s vychytávkami ako
- skryté kópie listov s pôvodnými dátami, a výpis aj pôvodných hodnôt
- výpis hodnôt všetkých zmenených buniek, nielen prvej v zmenenej oblasti (kopírovanie, mazanie, vypĺňanie)
- ošetrenie nesúvislého výberu (Areas)
...
Tiež sa často snažím urobiť All-In-One, ale len preto, aby som dodatočne dostával čo najmenej ďalších otázok a problémov. To všeobecne, nielen Excel.
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.