Excel vzorce VBA - help

[Guest StibTo]

Excely az do 2003 nebo 2007 mely 65536 radecku, ted uz je to 1048576

Kolonek je take vice, doted to bylo 256, ted je neco pres 16.000

Jo, bude to dobry peklo. Chjo ..

[punkac]

2007 už měla více řádků než 65000

jinak dobrý téma, se zájmem sleduju

[Guest StibTo]

Jj taky mam dojem ze uz 2007 mela vic. My jsme v praci po neskutecnym dlouhym slibovani presli na 2010-tky cca v rijnu, ted zase ale resime, ze \"byznys\" (= WEZ pro me treba Belgie) ma starsi verzi. Takze jim stejne musim ukladat soubory jako *.xls a myslet na to abych v makrech nepracoval s vice radky ci kolonkami :roll

[punkac]

mám v rachotě docela složitý makro (vlastní výroba, se někdy pochlubím), který otvírá jiný soubory, některé v sobě mají makro, některé ne. A tahá to z nich data. Když jsem ten soubor měl uložený ve verzi 2007, kterou používáme, nešlo to pustit, za boha tymakra byly bloklý. Když to uložím jako verzi 2003, funguje vše bez problémů.

Zajímavý je, že vše mám povolený. Vytvořím nějaký jednoduchý makro, který nic netahá z jinejch souborů a to spustit jde v obou verzích 2003 i 2007.

U toho prvního jsem zkusil všechny podsoubory převést na verzi 2007 a stejně to nepomohlo

[Guest StibTo]

Tzn jako \"Excel 97-2003 Workbook (*.xls)\" to funguje a jinak ne ?

A co Ti to hazi za chybu ?

Btw takovych maker co popisujes mam vic, v podstate na import dat z jineho soubuiru, ktery si to otevre, poupravi a zase zavre, to vse bez \"screen update\" tzn na pozadi Docela da praci to udrzovat, musim porad myslet na to abych si ty soubory treba neprejmenoval

[Guest Raubiri]

To bys měl mít uložený jako xlsm, ne? (ve 2010 v xls makra též nefungujou)

stibto:

nevíš jak udělat, aby se mě excel při vytvoření souboru zeptal na jméno jak se to má jmenovat, nebo to rovnou doplnil podle určité buňky? (aktuální datum)

Dim fs As Object, a As Object, k As Integer, s As String

Set fs = CreateObject(\"Scripting.FileSystemObject\")

Set a = fs.CreateTextFile(\"U:\\datum.ski\", True)

For k = 2 To 10000

If Not IsEmpty(Cells(k, \"Q\")) Then

s = Cells(k, \"Q\")

a.WriteLine s

Else

End If

Next k

a.Close

MsgBox \"U:\\soubor.ski\"

[Edited on 17/1/13 12:01 by Raubiri]

[Guest StibTo]

Raubiri : se Scripting objekty prakticky nepracuju, takze asi neporadim

Jedine s cim pracuju je treba vytvoreni a ulozeni nove Excel souboru, nazev a cesta pak bud pres InputBox a vypsat nebo si to vezme info z nejake bunky kde muze byt treba \"C:\\Documents And Settings\\\" atd

Ted jsem na ten tracker delal kus kodu aby to pri otevreni (prvni clovek rano) zapsalo na disk svoji kopii jako zalohu + vypisovalo jmena lidi kteri soubor otevrou a kdy :

Private Sub Workbook_Open()

ThisWorkbook.SaveCopyAs \"\\\\wegdafs6\\Data5\\OTC_New\\Team Folders\\Invoicing\\\" & _

\"BACKUP \" & ThisWorkbook.Name & \" \" & Date & \" \" & Now & \".xlsm\"

Sheet8.Range(\"G12\").Offset(1, 0) = Application.UserName

Sheet8.Range(\"H12\").Offset(1, 0) = Now

End Sub

[Guest Raubiri]

No jo..když ty to máš zmáklý to já se v tom plácám jak ryba v louži.

Pro dnešek musím nechat P-C forum na pokoji...jinak budu vykazovat podprůmernou činnost a nebudu vyhlášenej zaměstnancem měsíce

Ba ne...jdu dělat že dělám

[punkac]

Dělá to to, že po proběhu makra to uloží pod daným jménem plus aktuální datum

např. Quality_daily_report_13.01.17, zítra to bude Quality_daily_report_13.01.18 atd...

Dim Mydate

Mydate = Date$ \'mydate nabyde hodnoty aktuálního datumu ve tvaru mm-dd-rrrr

sFilename = \"Quality_daily_report_\" + Mydate + \".xls\" \'tvar uložení souboru

sDir = \"c:\\blabla\" \'místo uložení souboru na disku do složky c:\\blabla

ActiveWorkbook.SaveAs Filename:=sDir + sFilename, FileFormat:=xlNormal _

, Password:=\"\", WriteResPassword:=\"\", ReadOnlyRecommended:=False, _

CreateBackup:=False \'uloží soubor pod názvem s datumem

doplněno pro Stibto:

ano to makro chodí pod excelem 2007 pouze pokud jsou všechny soubory ve verzi 2003, fakt nevím proč to tak je, nevíc, dříve to chodilo, ať bylyvjakýchkoliv verzích, nevím jestli do toho nekecá nějaký globální firemní nastavení

[upravil dne 17/1/13 14:08 od punkac]

[Guest StibTo]

punkac : Hm to bych se potreboval naucit trosku lip tohle myslim to prochazeni slozek, jejich vytvareni ci mazani a podobne ...

Btw nedavno jsem treba blbnul a zkoumal a objevil kod ktery umi veci i vymazavat a dokonce nejaky Shell.Dll prikaz na vyprazdeni kose

Schvalne jeslti si vzpomenu :

Kill C:/ ..cesta k souboru / .. nazev souboru .doc třeba

[Guest Raubiri]

Po delší době oživím :-)

Potřebujoval bych aby excel z řádku

\":86:110~20AMT RCD EUR 5106,26 ~21 ~\"

vytáhl z řádku potřebná data, tou jest výška platby 5106,26 a dal jí správné znaménko pod RCD (přijatá +)

řádek je v jedné buňce.

[Guest StibTo]

Hoj.

Ta bunka (bunky) maji VZDY stejnou strukturu ? Myslim tim napriklad ze vzdy se tam nachazi \"EUR\" - podle cehoz by se pomoci fkce Instr dalo orientovat ?

Tu druhou cast nechapu - myslis znamenko PODLE RCD (RCD=received=prijata) ? To RCD tam je vzdy nebo tam je i neco jineho ?

[Guest Raubiri]

jo je to tam pořád.

je to část výpisu z účtu, takže se pole stále opakují.

a ano RCD = přijátá +

a SNT = odeslaná -

Ale stačilo by mi, aby to excel z toho řádku vyrval RCD EUR 5106,26 a dal například do A1

[Guest StibTo]

Pokusim se, dej mi chvili

[Guest Raubiri]

Ouká Díky mistře

[Guest StibTo]

:mad: no neprechval me

[Guest Raubiri]

No tak musím tě nějak motivovat

[Guest StibTo]

Uff, nejak nejsem ve forme

Zkus tohle :

Vypis.xls

[Guest StibTo]

Ta podminka If Len( .... je tam aby to tu dalsi overovalo jen na radcich kde ve sloupci 1 (A) neco je.

Ta druha podminka hleda vyrazy RCD a SNT v bunce v prvnim sloupci radek po radku, kdyz je tam najde (jako ze by mela ! ) vystrihne z celeho retezce ten kus od toho RCD/SNT az v podstate na konec a vypise vedle (sloupec B).

No a na zaver je tam nahrazeni toho prebytecnyho kusu \"nicim\" aby to bylo cisty.

[upravil dne 5/2/13 11:25 od StibTo]

[Guest Raubiri]

No pěkné ale abych nezahálel tak jsem si to udělal oklikou po svém a jak jinak než prasácky...se to v životě nenaučím napsat tak nějak přehledně.

hlavně když jsem zkoušel nahradit tu vlnovku s číslem, tak mi to nahrazovalo jen vlnovku...a za boha jsem to nahrazení nemohl zprovoznit. tak přišlo na řadu řešení rozhodit to do sloupců a sloupce co jsem nepotřeboval prostě vymazat

Sub pokus()

Dim i, a, b, c, d, radek As Long

Dim LastRow As Long: LastRow = Range(\"I1048576\").End(xlUp).Row

i = 1

a = 1

b = 1

c = 1

d = 1

radek = 1

For i = 1 To LastRow

If Cells(i, \"I\") Like \":20:*\" Then

Cells(i, \"I\") = \"\"

Else

End If

If Cells(i, \"I\") Like \":25:*\" Then

Cells(i, \"I\") = \"\"

Else

End If

If Cells(i, \"I\") Like \":28C:*\" Then

Cells(i, \"I\") = \"\"

Else

End If

If Cells(i, \"I\") Like \":60F:*\" Then

Cells(i, \"I\") = \"\"

Else

End If

If Cells(i, \"I\") Like \":61:*\" Then

Cells(i, \"I\") = \"\"

Else

End If

If Cells(i, \"I\") Like \":86:*SNT*\" Then

Cells(a + radek, \"A\") = \"SNT\"

Cells(b + radek, \"B\") = Cells(i, \"I\").Text

radek = radek + 1

Cells(i, \"I\") = \"\"

Else

End If

If Cells(i, \"I\") Like \":86:*RCD*\" Then

Cells(a + radek, \"A\") = \"RCD\"

Cells(b + radek, \"B\") = Cells(i, \"I\").Text

radek = radek + 1

Columns(\"B:B\").Select

Selection.Replace What:=\":86:*EUR\", Replacement:=\"\", LookAt:=xlPart, _

SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

ReplaceFormat:=False

Columns(\"B:B\").Select

Selection.TextToColumns Destination:=Range(\"B1\"), DataType:=xlFixedWidth, _

FieldInfo:=Array(Array(0, 2), Array(12, 9), Array(40, 9)), TrailingMinusNumbers _

:=True

Cells(i, \"I\") = \"\"

Else

End If

Next i

End Sub

[Edited on 5/2/13 11:40 by Raubiri]