Dobrý den,
Potřeboval bych pomocí macra sloučit data ze sešitů "data","data1","data2",.... (pokaždé jiný název souboru)
do sešitu "data konec". Pouze konkrétní buňky! Přikládám přílohy se vzorovými daty.
Udaje v souborech "data" budou vždy na teto pozici.
Děkuji za pomoc
Pomozte mi sloučit data z více sešitů. Přikládám přílohy.* Vyřešeno
Pomozte mi sloučit data z více sešitů. Přikládám přílohy.* Vyřešeno
- Přílohy
-
- data2.xlsx
- (10 KiB) Staženo 65 x
-
- data1.xlsx
- (10 KiB) Staženo 55 x
-
- data.xlsx
- (10 KiB) Staženo 56 x
-
- data konec.xlsx
- (10.07 KiB) Staženo 62 x
Naposledy upravil(a) mike007 dne 09 lis 2010 04:50, celkem upraveno 3 x.
Důvod: Zlidštění nadpisu „Report s více sešitů“. Opraven překlep v nadpisu.
Důvod: Zlidštění nadpisu „Report s více sešitů“. Opraven překlep v nadpisu.
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Report s více sešitů
Nize uvedenou proceduru vloz v editoru VBA (Alt+F11) do standardniho modulu sesitu data konec.xlsm (cilovy soubor). Uprav v procedure disk a adresar zdrojovych souboru a nazvy listu zdrojovych souboru a ciloveho souboru, pripadne vychozi bunky na zdrojovem a cilovem listu. Spustit klavesou F5 v editoru VBA. Zdrojove sesity jsou postupne otevirany a prenesena data v rozsahu poskytnuteho dema, cilovy sesit je na zaver ulozen.
Kód: Vybrat vše
Option Explicit
Sub SloucitData()
Dim MsgResponse As Byte
Dim objFSO As Object, objDir As Object, aItem As Object
Dim CntFFile As Integer, SPath As String, SFileType
Dim Swbk As Workbook, SWsht As Worksheet, SCll As Range
Dim SWshtName As String, SCllAddr As String
Dim TWbk As Workbook, TWsht As Worksheet, TCllAddr As String
Dim TCll As Range, TOffsR As Long, TWshtName As String
'*********upravit dle realu**********
SPath = "E:\Excel\dodov" ' katalog zdrojovych sesitu
SFileType = "xlsx" ' rozsireni .xlsx
' nazev listu a vychozi bunka
SWshtName = "list1" ' zdrojovych sesitu
SCllAddr = "c6"
TWshtName = "list1" ' ciloveho sesitu
TCllAddr = "c8"
'************************************
' v katalogu otevirat jednotlive soubory, prenest data
' definovat objekt FSO
Set objFSO = CreateObject("scripting.filesystemobject")
On Error Resume Next
' katalog
Set objDir = objFSO.GetFolder(SPath)
If Err.Number <> 0 Then
MsgResponse = MsgBox("Katalog zdrojových souborù nebyl nalezen." & vbCr _
& "Konec.", vbOKOnly + vbExclamation)
GoTo Err3
End If
On Error GoTo 0
' pocet souboru
CntFFile = objDir.Files.Count
' pokud CntFFile=0, zobrazi hlasku
If CntFFile > 0 Then
' definovat cilovy sesit, list, vychozi bunku, offset
Set TWbk = ThisWorkbook
Set TWsht = TWbk.Worksheets(TWshtName)
Set TCll = TWsht.Range(TCllAddr)
TOffsR = 0
' ve smycce otevirat zdrojove sesity
For Each aItem In objDir.Files
If objFSO.GetExtensionName(aItem) = SFileType Then
' definovat zdrojovy sesit, list, vychozi bunku
Set Swbk = GetObject(aItem)
Set SWsht = Swbk.Worksheets(SWshtName)
Set SCll = SWsht.Range(SCllAddr)
' prenest data
TCll.Offset(TOffsR, 0).Value = SCll.Value
TCll.Offset(TOffsR, 2).Value = SCll.Offset(1, 0).Value
TCll.Offset(TOffsR, 4).Value = SCll.Offset(2, 0).Value
Swbk.Close False ' zavrit zdrojovy sesit
Set SCll = Nothing
Set SWsht = Nothing
Set Swbk = Nothing
TOffsR = TOffsR + 1
End If
Next aItem
With Application
.DisplayAlerts = False
TWbk.Save ' ulozit cilovy sesit
.DisplayAlerts = True
End With
Else ' nebyl nalezen zadny soubor
MsgResponse = MsgBox("Katalog zdrojových souborù: '" & SPath & "' je prázdný!", _
vbOKOnly + vbInformation)
End If
Set TCll = Nothing
Set TWsht = Nothing
Set TWbk = Nothing
Err3:
Set aItem = Nothing
Set objDir = Nothing
Set objFSO = Nothing
End Sub
Re: Pomozte mi sloučit data z více sešitů. Přikládám přílohy
Díky funguje to paradně
Re: Pomozte mi sloučit data z více sešitů. Přikládám přílohy
Chtěl jsem si sám dodat do listu1 tlačítka na spuštení a smazání, ale vůbec se mi nedařilo, mohu poprosit o pomoc?
Koukal jsem do jiných maker, abych předělal do tohoto listu, ale bouzel :(
Stačilo by mi tlačítko spuštení a smazání bych si rád potom podle vzoru skusil udělat sám.
Koukal jsem do jiných maker, abych předělal do tohoto listu, ale bouzel :(
Stačilo by mi tlačítko spuštení a smazání bych si rád potom podle vzoru skusil udělat sám.
- Branscombe
- Level 3
- Příspěvky: 469
- Registrován: červen 09
- Pohlaví:
- Stav:
Offline
Re: Pomozte mi sloučit data z více sešitů. Přikládám přílohy
V příloze najdeš soubor s tlačítkem z ovládacích prvků formuláře...
- Přílohy
-
- data.xlsm
- (18.76 KiB) Staženo 80 x
Re: Pomozte mi sloučit data z více sešitů. Přikládám přílohy
Díky, už vidím kde jsem dělal chybu, vkládal jsem tlačítko z ovládacích prvku ActiveX
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Pomozte mi sloučit data z více sešitů. Přikládám přílohy
Ovladaci prvky z Formularu jsou pozustatkem starych verzi Excelu (<<2000) z duvodu kompatibility.
Ovladaci prvky ActiveX jsou plne programove podporovany z VBA, takze je lze jednoduse za behu programu prizpusobovat. Bohuzel je to trochu narocnejsi na znalosti, coz vede k jejich opomijeni mene zdatnymi a tvrdosijne pouzivani z Formulare..
neco na uvod: http://www.officir.ic.cz/chipex05/07/ex ... _form.html
Ovladaci prvky ActiveX jsou plne programove podporovany z VBA, takze je lze jednoduse za behu programu prizpusobovat. Bohuzel je to trochu narocnejsi na znalosti, coz vede k jejich opomijeni mene zdatnymi a tvrdosijne pouzivani z Formulare..
neco na uvod: http://www.officir.ic.cz/chipex05/07/ex ... _form.html
Naposledy upravil(a) navstevnik dne 10 lis 2010 09:58, celkem upraveno 1 x.
Re: Pomozte mi sloučit data z více sešitů. Přikládám přílohy
Jen tak pro zajímavost, jak by byl kod ve VBA pro tlačítko, který mi sem dal Branscombe? ja to včera práve skoušel pomoci prvku ActiveX a jelikož jsem v tomhle začátečník tak jsem to zkoušel opisovat z jiného macra, ale nepodařilo se mi. Někde jsem na něco zapoměl.
Si můsím sehnat nejakou učebnici
Si můsím sehnat nejakou učebnici
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Pomozte mi sloučit data z více sešitů. Přikládám přílohy
V priloze je ukazka pouziti tlacitka z ActiveX, vyhodnoceni stisku je v modulu List1 a vykonna procedura aktivovana stiskem tlacitka je v modulu Module1
- Přílohy
-
- Ukazka.xlsm
- (17 KiB) Staženo 77 x
Re: Pomozte mi sloučit data z více sešitů. Přikládám přílohy
Aplikoval jsem do svýho macra a vše funguje, mám dojem, že jsem to včera měl taky takhle, ale to už ted nezjistím.
Děkuji za Vaši pomoc
Děkuji za Vaši pomoc
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 4
- 2349
-
od ski1961
Zobrazit poslední příspěvek
08 říj 2023 11:40
-
-
Data science desktop cca 70k Příloha(y)
od Siderit » 24 srp 2023 12:02 » v Rady s výběrem hw a sestavením PC - 10
- 1651
-
od Siderit
Zobrazit poslední příspěvek
25 srp 2023 20:02
-
-
- 7
- 744
-
od atari
Zobrazit poslední příspěvek
dnes, 09:56
-
- 4
- 874
-
od jan l
Zobrazit poslední příspěvek
11 led 2024 20:15
-
- 2
- 982
-
od Myerina
Zobrazit poslední příspěvek
20 dub 2024 11:36
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 4 hosti