Stránka 1 z 2
VLOOKUP...automaticky posun o dalsi stlpec
Napsal: 05 bře 2012 21:30
od marek26
ahoj
toto makro urobi to ze funkciu vlookup pouzije v bunke D2 a potiahne dole nakoniec tab.
Ako zabezpecit to ze nech automaticky o dalsi mesiac bude robit presne to iste s tym ze vlookup zacne na bunke marec cize E2.
Range("D2").Select by malo byt inak definovane napr. select first free cell after D2? neviem vsetko ostatne sa nemeni.
Najprv vlookup je za januar potom febr. .....dec 12x to musim robit. preto ak sa to da osetrit nejakou formulaciou "dalsia volna bunka v poradi"
dik
Workbooks.Open Filename:="C:\Users\marek\Desktop\ciel.xls"
Workbooks.Open Filename:="C:\Users\marek\Desktop\zdroj.xls"
Windows("ciel.xls").Activate
Range("D2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-2],[zdroj.xls]zakaznik!C1:C2,2,0)"
Selection.AutoFill Destination:=Range("D2:D12")
Range("D2:D12").Select
Range("D2").Select
End Sub
Re: VLOOKUP...automaticky posun o dalsi stlpec
Napsal: 05 bře 2012 23:05
od d1amond
POkud budeš chtít automatiku v posunu na další volnou buňku a následné doplnění, neobejde se to bez definice proměnných. Bylo by lepší dát sem příklad v excelovských sešitech. Jinak tu nahážem 10 procedur, protože to každý pochopí jinak a po svém.
Re: VLOOKUP...automaticky posun o dalsi stlpec
Napsal: 06 bře 2012 08:14
od marek26
tak som prilozil, prilohy (zdroj- odkial sa tahaju data) a (ciel - prihadzuju sa data na zaklade stlpca ico -bunka A) ale povode som myslel ze namiesto Range(D2) select bude formula +1 cell alebo tak ze to bude stacit.
dakujem
Re: VLOOKUP...automaticky posun o dalsi stlpec
Napsal: 06 bře 2012 10:24
od d1amond
Ano, to by stačilo, ale jen pro aktivaci buňky. Jak by se informace o "začátku" předala dál? Nyní jsou všechny hodnoty Range napevno danné. Ale my je potřebujeme měnit podle první prázdně buňky.
Re: VLOOKUP...automaticky posun o dalsi stlpec
Napsal: 06 bře 2012 10:48
od marek26
existuje takova moznost?
Re: VLOOKUP...automaticky posun o dalsi stlpec
Napsal: 06 bře 2012 12:37
od d1amond
Jinak bych to tu nepsal
Podívám se na to večer.
Re: VLOOKUP...automaticky posun o dalsi stlpec
Napsal: 07 bře 2012 22:07
od marek26
asi je to troska slozitejsie
Re: VLOOKUP...automaticky posun o dalsi stlpec
Napsal: 08 bře 2012 07:32
od d1amond
Není, jen jsem na to jetě nedostal
Napravím to co nejdříve
Re: VLOOKUP...automaticky posun o dalsi stlpec
Napsal: 08 bře 2012 19:13
od marek26
dakujem ti d1amond budem rad
Re: VLOOKUP...automaticky posun o dalsi stlpec
Napsal: 08 bře 2012 19:35
od d1amond
Teď jsem na to koukal. Používáš VLOOKUP proč? Nebude někdy souhlasit Název položky ze sešitu zdroj s názvem položky v sešitu cíl neo opačně(počtem nebo názvem)? Pokud by to mělo kopírovat data 1:1, bylo by to opravdu jednoduché procházení a kopírování. Jinak to samozřejmě lze kontrolovat, zda název položky zdroje odpovídá názvu z cíle.
Rovněž by nebylo nutné hledat zdlouhavě následující prázdný sloupec, když jde o pravidelný měsíc. Stačí zjistit číslo aktuální měsíce a podle toho vybrat sloupec který se naplní daty.
Re: VLOOKUP...automaticky posun o dalsi stlpec
Napsal: 09 bře 2012 09:40
od marek26
no potesim ta, nie podla nazvu ale podla pola "ico" stlpec A bude porovnanaci, (ico bude synchronizacny stlpec ), dalej
ano mas pravdu, januar je pevne stanoveny napr. stlpec "C" (febr="D", marec="E" ......dec="N")
tu dole su 2 prilohy aktualne ako by to mohlo byt:
v tab. CIEL su 2 listy(zosity) = "obrat" , "vynos"
prosim skus to nasledovne:
nech "obrat" (zdroj.xls stlp. "C") da do zosita "obrat" v ciel.xls stlp.C
nech "vynos" (zdroj.xls stlp. "D") da do zosita "vynos" v ciel.xls stlp.C
zdroj.xls stlp. "C"a"D" sa nemeni pozicne, v kazdom mesiaci je na rovnkej pozicii (februar bude tiez C,D,) tie udaje sa len aktualizuju
dufam ze je to zrozumitelne
dakujem
Re: VLOOKUP...automaticky posun o dalsi stlpec
Napsal: 09 bře 2012 23:37
od d1amond
Hotovo. Pro otestování jsem v ciel.xls na listu obrat dal do buňky B1 datum, který si můžeš zkusit měnit a zjišťovat co se děje.
Procedura je v sešitu ciel.xls. Na začátek je kontrola, zda je otevřený sešit zdroj.xlx (když ne, končí hláškou) a zda existují listy "obrat" a "vynos". Z datumu se vezme číslo měsíce = číslo sloupce pro naplnění daty.
Nezajímá mě počet ICO ve zdroj.xls, primárně procházím sloupec A v ciel.xls a následně hledám tyto hodnoty ve zdroj.xls - sloupec A. Pokud nenajdu shodu, pokračuji dalším řádkem(ICO) v ciel.xls. Lze libovolne do obou sešitů přidávat firmy, při neshodě se údaj přeskakuje.
pokud vše pojede jak má, smaž v kódu
mes = Month(wsh2.Cells(1, 2).Value) ' a bude se brát aktuální měsíc - lze provádět v jednom měsíci opakovaně, naplnění se vždy aktuální hodnoty.
Kód: Vybrat vše
Option Explicit
Sub VynosyObraty()
Dim col As Byte 'radek pro doplneni
Dim mes As Byte 'mesic
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim wsh1 As Worksheet 'zdroj
Dim wsh2 As Worksheet 'obrat
Dim wsh3 As Worksheet 'vynos
Dim r1 As Integer
Dim r2 As Integer
Dim ico As String
Dim rng As Range
Dim obrat As Variant
Dim vynos As Variant
Dim errMsg As String
Application.ScreenUpdating = False
On Error Resume Next
errMsg = ""
'nastaveni souboru
Set wbk1 = Workbooks("zdroj.xls")
Set wbk2 = ThisWorkbook
'nastaveni listu
Set wsh1 = wbk1.Worksheets(1)
Set wsh2 = wbk2.Worksheets("obrat")
Set wsh3 = wbk2.Worksheets("vynos")
On Error GoTo err
'kontroly sesitu a listu
If wbk1 Is Nothing Then
errMsg = errMsg & Chr(10) & Chr(13) & "Nie je otvoreny zdrojovy zosit!"
GoTo err
End If
If wsh2 Is Nothing Then
errMsg = errMsg & Chr(10) & Chr(13) & "Harok obrat neexistuje!"
GoTo err
End If
If wsh3 Is Nothing Then
errMsg = errMsg & Chr(10) & Chr(13) & "Harok vynos neexistuje!"
GoTo err
End If
mes = Month(wsh2.Cells(1, 2).Value) 'mes = CByte(Month(Date)) 'aktualni mesic
'podle mesice se nastavi cislo sloupce col
Select Case mes
Case 1: col = 4
Case 2: col = 5
Case 3: col = 6
Case 4: col = 7
Case 5: col = 8
Case 6: col = 9
Case 7: col = 10
Case 8: col = 11
Case 9: col = 12
Case 10: col = 13
Case 11: col = 14
Case 12: col = 15
End Select
'najde prvni radek s ico od konce
r2 = wsh2.Cells(Rows.Count, 1).End(xlUp).Row
Do While r2 > 1
ico = Trim(CStr(wsh2.Cells(r2, 1).Value))
'hleda shodu ico ve zdroji
wsh1.Activate
With wsh1.Range("A:A")
Set rng = .Find(What:=ico, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not rng Is Nothing Then 'je nalezena shoda
r1 = rng.Row
obrat = .Cells(r1, 3).Value
vynos = .Cells(r1, 4).Value
Else: GoTo dalsi 'neni nalezena shoda - dalsi ico
End If
End With
'doplneni vynosu a obratu do cilovych listu
wsh2.Activate
wsh2.Cells(r2, col).Value = obrat
wsh3.Activate
wsh3.Cells(r2, col).Value = vynos
GoTo dalsi
dalsi:
r2 = r2 - 1
Loop
Application.ScreenUpdating = True
wsh2.Activate
'regulerni konec procedury
Exit Sub
'konec procedury s chybou
err:
MsgBox errMsg, vbCritical
Exit Sub
End Sub
//nevěděl jsem jak chceš proceduru pouštět, takže zatím ručně přes Spustit makro. Dá se to doplnit na tlačítko, otevření sešitu, změny, atd...