Příspěvky uživatele

Já bych to nechal tak jak to je za předpokladu, že máš stejné názvy sloupců. Pak stačí udělat kontingenční tabulku do které navážeš všechny roky za sebou a souhrn si modeluješ podle potřeby. R.

??? zkusil jsem to a jde mi to. Tak nevím, jestli jsem to správně pochopil. R.

Nemám nyní 2007,10 takže to nepřečtu. Obecně mě napadají dva způsoby. Přes pomocníka nebo komentář v buňce.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Assistant
.Visible = True
With .NewBalloon
.Heading = "Ahoj ..."
.Text = "Zavolej mi do klubu ..."
.Icon = msoIconAlertQuery
End With
' .Visible = False
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
If .Comment Is Nothing Then
.AddComment ("Ahoj ... 1")
Else
.Comment.Text ("Ahoj ... 2")
End If
End With
End Sub

Přes makra to není problém. Pokud neumíš, pak si zapni nahrávaní a pak se podívej, jak se jemnují jednotlivé procedůry a funkce. Z toho pak sestav dynamickou tvorbu a ráno spusť.
K druhé části. Nechápu co je podle Tebe položky. Jak myslíš jednu položku sloupcovou a zároveň datovou ... ona ta položky se "přesune" z jednoho do druhého apod. Pokud ji chceš vícekrát, pak musíš použít výpočtové pole a nebo výpočtovou položky (asi ani to nebude fungovat). Do toho napíšeš že POLOŽKA1 = POLOŽKA2 a pak je možné jeden sloupec vést dynamicky 2x. Docela by mne zajímal případ, kdy potřebuje user v datové kostce jednu dimenzi na dvou místech. Tak si myslím, že to co požaduješ je nemožné. Odporuje to logice datové kostky ... nevím.

hmmmm ... Jeza.m ... :( ... zase předbíhá :(

V Listu1 by měl být první řádek prázdný.

Sub dopisAprepis()
Dim c As Range
Dim d As Range
Dim i As Long
Dim Src As Range

With Worksheets("List2")
.Activate
For Each d In .Range("A1:A" & Range("A65536").End(xlUp).Row)
With Worksheets("List1")
Set Src = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
'Debug.Print Src.Address
End With
Set c = Src.Find(d.Value, LookIn:=xlValues)
'Debug.Print d.Address
If Not c Is Nothing Then
For i = 1 To 3
c.Offset(0, i).Value = d.Offset(0, i).Value
Next i
Else
With Worksheets("List1")
Set c = .Range("A" & .Range("A65536").End(xlUp).Row + 1)
For i = 0 To 3
c.Offset(0, i).Value = d.Offset(0, i).Value
Next i
End With
End If
Next d
Set Src = Nothing
End With
End Sub

Zkus jiný popis ... taky by se hodil jiný vzor co vlastně chceš.

To je hezky napsané. Sice jsem v assemberu už 14 let nic nenapsal, ale kdyby jsi chtěl tak to zmastím

.
Chtěl jsem ještě navrhnout jedno řešení ... poněkud modernější. Divím se, že mne to nenapadlo včera.
Ve VBA je object Collection který bere Key a Item tj. bere "OK1" -> "15". Pokud bys z nějakého jiného důvodu potřeboval proměnnou OK1, OK apod. pak tudy cesta taky vede. Je to jen zapoudření array. Další cesta by byla přes vytvoření objektu nebo recordu a uložení do Collection. To bys pak mohl mít víc než jednu informaci k OK1. R.

Souhlasím s výše uvedeným. Použij klasické pole a proměnné smaž.

Sub pokus()

Dim r As Range
Dim i As Long ' čítač
Dim Pole() As Long

' Naplním pole hodnotami z označených buněk
i = 1
ReDim Pole(Selection.Count)
For Each r In Selection
Pole(i) = r.Value
i = i + 1
Next r

' Vypíšu pole do okenka "Immediate" ve VBA
Debug.Print "Výpis pole "
For i = 1 To UBound(Pole)
Debug.Print "Item " & i & " -> " & Pole(i)
Next i

' Vynuluji všechny hodnoty
For i = 1 To UBound(Pole)
Pole(i) = 0
Next i

' Vypíšu pole do okenka "Immediate" ve VBA
Debug.Print "Výpis nulovaného pole "
For i = 1 To UBound(Pole)
Debug.Print "Item " & i & " -> " & Pole(i)
Next i
End Sub

Nevím jak 2007 a 2010, ale podle mne to nejde. Byla by to velká bezpečnostní chyba a znamenalo by to otevřít dveře tvůrcům viru. Podle mne musí uživatel každé makro ručně povolit a od 2007 a 2010 musí být adresář v seznamu adresářů. Možná při vypnutí bezpečnostních prvků a zařazení do seznamu adresářů to půjde. Tj buď nemusí nic nebo každý sešit. Nicméně bych se tomuto řešení vyhnul. R.

Tak z adresáře ...
Function soubory()
Dim fs As Object
Dim f As Object
Dim adresar As String

On Error GoTo LabelErr
With Worksheets("List1")
.Activate
Set fs = CreateObject("Scripting.FileSystemObject")
adresar = "C:\Table\"
For Each f In fs.Getfolder(adresar).Files
Debug.Print f.Name
Call ProvedOperaci(f.Name)
Next f
End With
LabelErr:
End Function

Standardně tak fungují vzorce a aktualizace vzdálených odkazů. Nevím o způsobu načítání ze souboru aniž bych jej otevřel. Nyní mám seznam souboru, můžu zavolat pro každý soubor funkci, která jej zpracuje a pak soubor můžu zavřít. R.

Sub ProvedOperaci(sesit As Worksheets)
ThisWorkbook.ActiveSheet.Range("A1").Value = _
sesit("List1").Range("A1").Value
End Sub

Sub OtevreneSesity()
Dim c
For Each c In Workbooks
Debug.Print c.Name
If c.Name <> ThisWorkbook.Name Then
sesit
End If
Next c
End Sub

Procedura OtevreneSesity vypíše všechny otevřené sešity kromě sešitu, ze kterého je spouštěné makro.
A zavolá proceduru ProvedOperaci které předá jméno sešitu. V proceduře můžeš udělat co potřebuješ. ThisWorkbook je sešit z kterého je spouštěné makro. R.

Tak se ukaž ...

Eval je myslím v MSAccess. V Excelu je něco podobného a je to pod objektem Application.Evaluate, ale myslím, že na uvedený problém je to nepoužitelné. Za zkoušku nic nedáš :)

Evaluate je vlastně funkce, která něco dělá, zpracuje apod. V tomto případě by se hodila funkce, která nic dělat nebude a jen interpretu podstrčí kousek kodu, který má interpret vykonat. Aby se nemusel uvedený řádek pracně parsovat ... atd.
R.

Odeber data ... stačí 10 řádku a udělej si měření času na blok "For j = 7 To azpo Step 2 ... Next j"
Tento blok změř bez úprav a pak začni provádět úpravy.
Všimni si, že sss = aaa + bbb + ccc + ddd + eee + fff + ggg je v podstatě incování proměnné. Místo výpočtu stačí na počátek dát sss = 1 a pak (vba incování neumí) napsat místo
sss = aaa + bbb + ccc + ddd + eee + fff + ggg jen sss = sss + 1
Ve výpočtech se odkazuješ na ... sss
* 100Tento výpočet patří nahoru tj. upravit a přidat proměnnou ssA = (sss + 1) * 100
Kousek níže máš If sss > 0 ThenVzhledem k tomu, že For aaa začíná jedničkou bude tato podmínka vždycky pravdivá - je to zbytečný kod.
R.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje