Příspěvky uživatele

Samozřejmě to jde, na listě "přehled" by bylo tlačítko a přidružené makro by projelo všechny řádky na všech listech a porovnalo, jestli kombinovaný string "vygenerované označení" se už na přehledu nachází. Pokud ne, tak by to tam přidalo.
Ovšem uniká mi význam, proč tabulka s naprosto stejnou strukturou se vyskytuje na různých listech. Pokud jednotlivé listy reprezentují další parametr (třeba pobočka, oddělení nebo něco podobného), tak pořád se to dá držet v jediné tabulce s přidáním dalších rozlišovacích sloupců.
Čili z mého pohledu se vysoce pravděpodobně jedná o nevhodnou architekturu - a to se pak člověku nechce plýtvat energií.
Umíš obhájit tu nešťastnou strukturu?

Konti graf to sice umi, ale pro vymezeni casove oblasti by ses "ufajfkoval". Reseni od AL je elegantnejsi. Anebo by taky sla udelat kombinace obeho, cili zdrojem Konti tabulky by byla dynamicka oblast a ve strankovem filtru nebo sliceru by se urcoval produkt pro ktery se ma ten graf vykreslit

Ano, je to ObjectBrowser, ktery vyvojas z VBA prostredi tlacitkem F2. Ale orientace v tomto nastroji neni uplne intuitivni, chce to mit trochu praxe a zkusenosti

Pro transpozici pole pomocí VBA (bez pomocí excelu) používám následovnou funkci. Švihá neuvěřitelně rychle a 100.000 záznamů jí nedělá problém:

Sub Transponuj2DPole(Pole As Variant)
Dim tmpPole As Variant
Dim lb1 As Long, lb2 As Long, ub1 As Long, ub2 As Long
Dim r As Long, s As Long

lb1 = LBound(Pole, 1)
lb2 = LBound(Pole, 2)
ub1 = UBound(Pole, 1)
ub2 = UBound(Pole, 2)

ReDim tmpPole(lb2 To lb2 + ub2 - lb2, lb1 To lb1 + ub1 - lb1)

For r = LBound(Pole, 2) To UBound(Pole, 2)
For s = LBound(Pole, 1) To UBound(Pole, 1)
tmpPole(r, s) = Pole(s, r)
Next s
Next r

Erase Pole
Pole = tmpPole
End Sub

Potvrzuji Paloovy dohady, souhlasí to i s mými poznatky.
Jinak pokud není vyloženě důvod použít smyčku pro načítání pole, tak se dá načíst jedním příkazem:
Sub PokusPole()

Dim pole() As Variant
Dim KonecPole As Integer
Dim rgData As Range

KonecPole = Range("A1").CurrentRegion.Rows.Count
Set rgData = Range(Cells(1, 1), Cells(KonecPole, 1))
pole = rgData
Range(Cells(1, 2), Cells(KonecPole, 2)) = pole
End Sub

Když pak koukneš na to pole přes Locals Window, tak vidíš, že to pole je opravdu dvourozměrné

To je způsobeno tím, že poté, co přidáš prázdnou "Pozici", tak makro nezjistí správně nový volný řádek. Všimni si, že se to chytá poslední neprázdné buňky odspodu ve sloupci "L". Buď si architekturu té tabulky uprav tak, aby si alespoň v jednom sloupci měl zaručeně hodnotu v posledním řádku, anebo to budeš muset zjišťovat podle barvy buňky, stejně jak se to zjišťuje na listě "Pozice", což ale taky nemusí vždy dopadnout dobře. Zvlášť pokud s tím souborem budou dělat i jiní barvičkoví umělci.

mrkni sem
http://wall.cz/index.php?m=topic&id=23194
zrovna něco podobného jsem tady dneska použil v kódu

První nástřel v příloze. Jinak pro nás s US excelem je diakritika v názvech souborů a listů poněkud komplikace. Je lepší nebýt v těchto věcech až takovým vlastencem.

Předpokládám, že "malé zkušenosti" zahrnují alespoň schopnost nahrát a pak přehrát makro. Pro tento účel by to mělo fungovat dostatečně. Udělej to a pokud to funguje tak pošli nahraný kód. Pak ho společně upravíme, aby to fachčilo podle představ

První úlohu řeší tento kód (vykoná se pro řádek, kde stojí kurzor):
Sub Macro27()

Dim iRow As Long, i As Long
Dim jCol As Integer, j As Integer
Dim strX As String

i = ActiveCell.Row

For j = 1 To 11

If Len(strX) = 0 Then
strX = Chr(34) & CStr(Cells(i, j).Text) & Chr(34)
Else
strX = strX & "," & Chr(34) & CStr(Cells(i, j).Text) & Chr(34)
End If

Next j

Cells(i, "L") = strX

End Sub

Nějaké případné nesrovnalosti s formátem datumu nebo podobně můžeme doladit.

Pokud potřebuješ export v csv, tak dáš ten excel uložit jako a zvolíš formát csv. Ovšem možná myslíš export do texťáku. I s tím si poradíme, pokud je to tento případ

"opakovat do předem stanovené buňky" by znamenalo, že si to budeš pořád přepisovat. Dohaduju, že máš na mysli, aby se to pokaždé zkopírovalo na nový řádek?
Takže to byl dotaz č.1.
č.2 - čím by se dalo zajistit, abys nějakou pozici nezkopíroval opakovaně?
č.3 - ty sloučené buňky tam opravdu musí být?
č.4 - sloupcová struktura na obou listech bude zaručeně totožná?

Úžasné!!!
To je presne ono. Tie textové konvencie sú niekedy nepochopiteľné. Zopakujem riešenie:

Sub aStart()

Dim record As String
Open ActiveWorkbook.Path & "\test.txt" For Output As #1
For x = 1 To 10
record = Empty
For y = 1 To 10
record = record & """" & Cells(x, y) & """ "
Next
Print #1, record
Next
Close #1

End Sub

Ďakujem Paloovi

Ahoj Igor,

vďaka za snahu, ten textový výstup je oddelený medzerami, so far so good.
Ale ďalšou podmienkou je že každá hodnota ešte musí byť "obalená" úvodzovkami.
To je ten problém, nad ktorým si lámem hlavu.
M.

To nahradit myslíš jako pak v tom notepadu?
No, má to být pro denodenní aktualizaci databáze a toto by byla ruční operace navíc, která, pokud by se zapomněla provést, tak nevím, co by to mohlo v té DB způsobit.

Upřednostnil bych, kdyby to šlo komplet vytvořit ve VBA, ale přesto dík za řešení. Pokud neobjevíme čistější způsob, tak se to asi bude muset dělat takhle

Zdar borci,
potřebuju makrem vyexportovat obsah tabulky do texťáku, ale tahle:
"hodnota1" "hodnota2" "hodnota3"
"hodnota3" "hodnota4" "hodnota5"

Takže každá hodnota musí být uzavřena do úvozovek a mezi nimi mezera, žádné čárky ani středníky

Povedlo se mi to zatím jenom takhle:
"hodnota1 hodnota2 hodnota3"
"hodnota4 hodnota5 hodnota6"
anebo takhle:
"hodnota1"" ""hodnota2"" ""hodnota3"
"hodnota4"" ""hodnota5"" ""hodnota6"

Ale ani jedno neni ono.
Prosím o help.
Milan

Použil jsem tenhle kód:

Sub ExportTXT1()

Dim ExpRng As Range
Dim FirstCol As Integer, LastCol As Integer, FirstRow As Integer, LastRow As Long, r%, c%
Dim Hodnota As String, strTXT As String

Range("A2").Activate

'zjisti hranice oblasti pro export
Set ExpRng = ActiveCell.CurrentRegion
FirstCol = ExpRng.Columns(1).Column
LastCol = FirstCol + ExpRng.Columns.Count - 1
FirstRow = ExpRng.rows(1).Row
LastRow = FirstRow + ExpRng.rows.Count - 1

'otevri
Open ThisWorkbook.Path & "\Text_CSV2.txt" For Output As #1

' 'exportuj po radcich
' For r = FirstRow To LastRow
' For c = FirstCol To LastCol
' Hodnota = ExpRng.Cells(r, c).Value
'
' If c = FirstCol Then
' strTXT = Hodnota & Chr(34)
' Else
' If c < LastCol Then
' strTXT = strTXT & " " & Chr(34) & Hodnota & Chr(34)
' Else
' strTXT = strTXT & " " & Chr(34) & Hodnota
' End If
' End If
' If c = LastCol Then Write #1, strTXT
'
' Next c
' Next r

'exportuj po radcich
For r = FirstRow To LastRow
For c = FirstCol To LastCol
Hodnota = ExpRng.Cells(r, c).Value

If c = FirstCol Then
strTXT = Hodnota
Else
If c < LastCol Then
strTXT = strTXT & " " & Hodnota
Else
strTXT = strTXT & " " & Hodnota
End If
End If
If c = LastCol Then Write #1, strTXT

Next c
Next r

Close #1
End Sub

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje