Stránka 1 z 3
Excel - makro
Napsal: 30 bře 2013 17:16
od Tomek001
Ahojte,
nebudu zdržovat, tudíž krátce.
Mám dílčí excelovské soubory označené jako Vzorek 1-3.xlsx. V každém z nich je na daném listu v dané buňce jeden parametr (ten je vždy umístěn na stejném místě v každém sešitě). Velice by mi pomohlo, kdyby mi tady někdo napsal konkrétní makro, které by kopírovalo data z označených "zažlutěných" buněk ze sešitů Vzorek 1-3.xlsx do jednoho sešitu Master.xlsx (zase do vyznačených žlutých oblastí).
S makry skoro neumím, takže prosím polopatisticky.
Všechny výše zmíněné excelovské soubory jsou zararované v příloze.
Moc děkuji!
Re: Excel - makro
Napsal: 30 bře 2013 17:45
od cmuch
Pokud budou ty tři sešity pořád na stejném místě, lze ty hodnoty tam dostat i pomocí propojení.
např: ='C:\cesta\[sešit2.xlsx]List1'!$B$3 (hodnota ze sešitu 2 a buňky B3)
Re: Excel - makro
Napsal: 30 bře 2013 17:54
od Tomek001
Děkuji za radu cmuchu,
nicméně mám těch sešitů i listů ve skutečností mnohem více než v tomto modelovém příkladě - a nové data stále přibývají. Tudíž to už považuju za pracné a z tohoto důvodu bych to rád (propojoval, kopíroval) pomocí makra.
Re: Excel - makro
Napsal: 30 bře 2013 18:36
od cmuch
Tak toto chtělo též uvést již na začátku
mám těch sešitů i listů ve skutečností mnohem více než v tomto modelovém příkladě - a nové data stále přibývají
Pokud toto nepopíšeš přesněji tak makro sice tady někdo vymyslí na ten tvůj model, ale věřím, že na to co ho ve skutečnosti potřebuješ již fungovat nebude.
Takže
Kde budou všechny sešity, budou ve stejné složce?
Co názvy listů, budou stejné ve všech sešitech?
Data co se mají kopírovat, budou ve stejných buňkách ve všech sešitech?
....
Re: Excel - makro
Napsal: 30 bře 2013 18:58
od Tomek001
Jasně, není problém, klidně se ptej - popíšu.
Co se týče Tvých výše uvedených dotazů, tak všude je odpověď ano:
1) Všechny sešity se mohou nacházet (a nacházejí pro zjednodušení) v jedné složce.
2+3) Jak názvy listů, tak rozmístění kopírovaných buňěk jsou ve všech sešitech ze kterých potřebuju tahat data, STEJNÉ - je to pro zjednodušení vše z jedné šablony.
Nevím, co všechno by Tě ještě zajímalo, rád zodpovím další upřesňující dotazy :-)
Re: Excel - makro
Napsal: 31 bře 2013 14:32
od Tomek001
Tak mám to makro :-)
Kód: Vybrat vše
Sub LoadData()
Dim aRange As Range
Dim aIndex As Integer
Dim aOpened As Boolean
Dim aFilename As String
Dim aWorkbook As Workbook
Set aRange = Range("C3:E5")
For aIndex = 1 To aRange.Rows.Count
aFilename = "Vzorek " & aIndex & ".xlsx"
On Error Resume Next
Set aWorkbook = Workbooks(aFilename)
On Error GoTo 0
If aWorkbook Is Nothing Then
Set aWorkbook = Workbooks.Open(ThisWorkbook.Path & "\" & aFilename)
aOpened = True
End If
aRange.Cells(aIndex, 1).Value = aWorkbook.Worksheets("Povrch").Range("B5")
aRange.Cells(aIndex, 2).Value = aWorkbook.Worksheets("Objem").Range("C5")
aRange.Cells(aIndex, 3).Value = aWorkbook.Worksheets("Poloměr").Range("D5")
If aOpened Then
aWorkbook.Close False
aOpened = False
End If
Set aWorkbook = Nothing
Next aIndex
End SubTeď jsem ale zjistil, že ve složce se mohou vyskytovat i jiné názvy souborů než Vzorek 1-3.xlsx (samozřejmě se stejnou strukturou buněk). Je možné to makro upravit tak, aby kopírovalo data bez ohledu na název souboru (tedy aby bralo všechny xlsx soubory)?
Re: Excel - makro
Napsal: 31 bře 2013 18:23
od cmuch
Koukám, že už tu makro máš.
Tady je jiné a řeší i různé názvy souborů.
Spouští se samo po změně ve sl.B (hodnota v bunce je i nazev sesitu)
Nakopíruj do modulu listu Parametry.
Kód: Vybrat vše
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AktWbNm As Variant
Dim RowNmWB As Long
Dim Response As Byte
Dim fso, WBOpen As Object
Dim File As String
' Proved kdyz je zmena ve sloupci, 1=A
If Target.Column = 2 Then
Set fso = CreateObject("Scripting.FileSystemObject")
File = ThisWorkbook.Path & "\" & Target.Value & ".xlsx"
' existuje soubor?
If (fso.FileExists(File)) Then
RowNmWB = Target.Row
AktWbNm = ThisWorkbook.Name
Set WBOpen = Workbooks.Open(File)
Application.EnableEvents = False
Workbooks(AktWbNm).Sheets("PARAMETRY 1").Range("C" & RowNmWB).Value = WBOpen.Worksheets("Povrch").Range("B5")
Workbooks(AktWbNm).Sheets("PARAMETRY 1").Range("D" & RowNmWB).Value = WBOpen.Worksheets("Objem").Range("C5")
Workbooks(AktWbNm).Sheets("PARAMETRY 1").Range("E" & RowNmWB).Value = WBOpen.Worksheets("Poloměr").Range("D5")
Application.EnableEvents = True
WBOpen.Close False
Else
Response = MsgBox("Soubor " & Target.Value & " nenalezen !! ", vbCritical)
End If
End If
Set fso = Nothing
Set WBOpen = Nothing
End Sub
Re: Excel - makro
Napsal: 31 bře 2013 19:17
od Tomek001
Tak to je paráda!!! Nemusím přejmenovávat soubory a celkově se mi tenhle postup zdá být lepším! :) Moc Ti děkuju :-)
--- Doplnění předchozího příspěvku (31 Bře 2013 23:04) ---
Mohu ještě jednu věc? Ve stejné buňce (A48) v každém sešitě je umístěn text - např, RFA. Lze název sešitu pojmenovat podle toho co je v této buňce umístěno? Nějak hromadně? Dle makra? Sešitů je přes 70.
Re: Excel - makro
Napsal: 02 dub 2013 07:12
od cmuch
Tady v sešitě je makro pro přejmenování souboru dle hodnoty v buňce na listu.
Re: Excel - makro
Napsal: 08 dub 2013 09:07
od Tomek001
Je to super, ale přejmenované sešity sice jdou otevřít, ale nic neobsahují - listy, nic (byť velikost mají srovnatelnou s původními) a nedá se v nich nic dělat
Re: Excel - makro
Napsal: 08 dub 2013 10:21
od cmuch
Hmm,
změnil jsem otevření sešitu z GetObjekt na Workbooks.Open
Upravena příloha předchozí.
Re: Excel - makro
Napsal: 08 dub 2013 11:52
od Tomek001
Funguje to!! Díky!
Jen ještě jedna věc (omlouvám se, že stále otravuju).
Mám následující kod:
Kód: Vybrat vše
Sub NačteVŠECHNAdataVadresari()
Dim aRange As Range
Dim aIndex As Integer
Dim aOpened As Boolean
Dim aFilename As String
Dim aWorkbook As Workbook
Set aRange = Range("G3:AG100")
For aIndex = 1 To aRange.Rows.Count
aFilename = "RUN_" & aIndex & ".xlsm"
On Error Resume Next
Set aWorkbook = Workbooks(aFilename)
On Error GoTo 0
If aWorkbook Is Nothing Then
Set aWorkbook = Workbooks.Open(ThisWorkbook.Path & "\" & aFilename)
aOpened = True
End If
aRange.Cells(aIndex, 1).Value = aWorkbook.Worksheets("Conditions").Range("B9")
aRange.Cells(aIndex, 2).Value = aWorkbook.Worksheets("Langmuir").Range("N26")
aRange.Cells(aIndex, 3).Value = aWorkbook.Worksheets("Langmuir").Range("N33")
aRange.Cells(aIndex, 4).Value = aWorkbook.Worksheets("DR and Medek").Range("P34")
aRange.Cells(aIndex, 5).Value = aWorkbook.Worksheets("DR and Medek").Range("P27")
aRange.Cells(aIndex, 6).Value = aWorkbook.Worksheets("DR and Medek").Range("Z27")
aRange.Cells(aIndex, 7).Value = aWorkbook.Worksheets("Micropores distribution").Range("N29")
aRange.Cells(aIndex, 8).Value = aWorkbook.Worksheets("Micropores distribution").Range("N36")
aRange.Cells(aIndex, 9).Value = aWorkbook.Worksheets("Langmuir").Range("N27")
aRange.Cells(aIndex, 10).Value = aWorkbook.Worksheets("Langmuir").Range("N34")
aRange.Cells(aIndex, 11).Value = aWorkbook.Worksheets("DR and Medek").Range("P35")
aRange.Cells(aIndex, 12).Value = aWorkbook.Worksheets("DR and Medek").Range("P28")
aRange.Cells(aIndex, 13).Value = aWorkbook.Worksheets("DR and Medek").Range("Z28")
aRange.Cells(aIndex, 14).Value = aWorkbook.Worksheets("Micropores distribution").Range("N30")
aRange.Cells(aIndex, 15).Value = aWorkbook.Worksheets("Micropores distribution").Range("N37")
aRange.Cells(aIndex, 16).Value = aWorkbook.Worksheets("Langmuir").Range("N28")
aRange.Cells(aIndex, 17).Value = aWorkbook.Worksheets("Langmuir").Range("N35")
aRange.Cells(aIndex, 18).Value = aWorkbook.Worksheets("DR and Medek").Range("P36")
aRange.Cells(aIndex, 19).Value = aWorkbook.Worksheets("DR and Medek").Range("P29")
aRange.Cells(aIndex, 20).Value = aWorkbook.Worksheets("DR and Medek").Range("Z29")
aRange.Cells(aIndex, 21).Value = aWorkbook.Worksheets("Micropores distribution").Range("N31")
aRange.Cells(aIndex, 22).Value = aWorkbook.Worksheets("Micropores distribution").Range("N38")
If aOpened Then
aWorkbook.Close False
aOpened = False
End If
Set aWorkbook = Nothing
Next aIndex
End Sub
1) Jak upravit výše uvedené makro, aby se načítaly všechny xlsm soubory bez ohledu na jejich název - ve složce mám tedy spoustu souborů s různými názvy. Řečený kod je umístěn v xlsm souboru s nazvem MASTER, který kolektuje data ze souborů RUN_1-100 které mají vždy stejnou strukturu (označení souborů jako RUN_se bohužel neosvědčilo) Podle mě by stačilo nějak upravit:
Kód: Vybrat vše
aFilename = "[b]RUN_"[/b] & aIndex & ".xlsm"2) Už umím pomocí makra importovat hodnoty z buňěk - např. použitím:
Kód: Vybrat vše
aRange.Cells(aIndex, 1).Value = aWorkbook.Worksheets("Conditions").Range("B9")Ale jak postupovat při importování hodnoty z formuláře?
Zkoušel jsem výše uvedený úryvek upravit na:
Kód: Vybrat vše
aRange.Cells(aIndex, 1).Value = aWorkbook.Worksheets("Conditions").Range("[b]skupina 124"[/b])ale nefunguje to :(