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

Příspěvky uživatele

s VB ide skoro vse

ale pracovat v myslienke ze zobrat udaj co som klikol pred tym je dost komplikovane :)))

ked napisete presnejsie co ta funkcia ma mat INPUT a co ma byt OUTPUT tak vam ju spravim :)

teraz neviem ci potrebujete len vysvetlit ako sa v outlooku nastavuje kalendar? alebo na aktualny dokument spravit makro ktore by to robilo samo?

prerobil som to na funkciu .... a teraz to robi presne ako si chcel :))

len problem je ze do funkcie musis zadavat
"=readPic("cell nazvu";"nazov image frame";"na sheete kde sa nachadza funkcia")"

.... nevedel som zistit v funkcii sheet namea :PP ... mozno niekto tu je chytrejsi a dojde nato aby sa ten jeden udaj nemusel zapisovat

trebalo tam doplnit tie frame a este v tom dokumente boli vypnute eventy
- dalsia vec som si vsimol ze tam sa ti nazvy odkazuju na iny list ... v takom pripade nefunguje change event ... dalo by sa to ale urobit inac a to na cuplik refresh picture

tu je to opravene:

radsej si v makre nastav aby ignorovalo warning hlasenia .)

Prerobil som Jeza.m sub na stlpce:
Public Sub radky()
Application.ScreenUpdating = False
For i = 1 To Columns.Count
If Cells(1, i) <> "" Then Cells(1, i + 1).EntireColumn.Insert
Next
Application.ScreenUpdating = True
End Sub

zaregistruj sa tu a mozes potom tu pridavat prilohy ... max je asi 0,5mb

nemal byt output 2,2,2,2,1,1 ???

a co ked bude 80,80,5,80 ma byt output 2,2,1,1?

hladal som nejaku funkciu ktora by vedela filtrovat Range podla IF podmienky ale nenasiel som

tak nakoniec som si spravil vlasnu funkciu "CucajMiesok"

v prilohe bude hned jasne ako funguje:

funkciou RANK

blizsie priloha:

tu som pozmenil Set find-u a uz to nerobi zlobu

skus toto:

takze treba sa spravne vyjadrovat makro pracuje spravne ale ja som ho zle napisal, to je tak ked ho pisem o pol noci :P

ale uz som nasiel chybu islo o to ze v makre sa vyhladava v akom stlpci ma doplnit udaj ... v mojom makre ho vyhladalo ale uz nezapisalo do spravneho stlpca

tu je to lepsie vidiet:
Private Sub writeData(ByVal z As Integer)
Dim aCell As Range

If z = 0 Then
For x = 0 To UBound(FileData, 2)
For y = 0 To UBound(FileData)
Cells(x + 1, y + 1) = FileData(y, x)
Next
Next
Else
For y = 0 To UBound(FileData)
Set aCell = ActiveSheet.Rows("1:1").Find(What:=FileData(y, 0), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
For x = 1 To UBound(FileData, 2)
Cells(aRow + x, aCell.Column) = FileData(y, x)
Next
Else
aColumn = Cells(1, 1).CurrentRegion.Columns.Count
Cells(1, aColumn + 1) = FileData(y, 0)
For x = 1 To UBound(FileData, 2)
Cells(aRow + x, aColumn + 1) = FileData(y, x)
Next
End If
Next
End If

aRow = aRow + UBound(FileData, 2)
End Sub


tu je to opravene:

prave to kontrolujem ... daj chvilu casu ... je tam moc vela udajov a je to dst neprehladne

netusim preco to dalo old subor

zmena bola len v sube:
Private Sub readData(ByVal z As Integer)
Dim SplitRow() As String
Dim SplitColumn() As String

Dim hf As Integer: hf = FreeFile
Open ActiveWorkbook.Path & "\data\" & FileName(z) For Input As #hf
SplitRow = Split(Input$(LOF(hf), #hf), vbNewLine)
Close #hf

For x = LBound(SplitRow) To UBound(SplitRow) - 1
SplitColumn = Split(SplitRow(x), ",")
If x = 0 Then ReDim FileData(UBound(SplitColumn), UBound(SplitRow) - 1)
For y = LBound(SplitColumn) To UBound(SplitColumn)
If y <= UBound(FileData) Then FileData(y, x) = SplitColumn(y)
Next
Next
End Sub


a aRow na double ... lebo tam znikol owerflow :P

tak este raz:

tuje to opravene tak aby bralo stlpce len podla prveho riadku

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse