Až to bude mít jasnou logiku...citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: automatický přenos dat mezi buňkami
MS Excel
Téma: automatický přenos dat mezi buňkami 
Zaslal/a Monty 16.4.2016 14:32
Dobrý den, moc vás prosím o pomoc. Potřebovala bych vymyslet makro, které by mi z jednoho listu automaticky přepisovalo změny do jiného listu. Jedná se o přepis hodnoty z buněk ze sloupce E (celého sloupce, nikoliv jen jedné buňky), z listu2 do listu1, přičemž buňku, do které má být vepsaná nová informace, si musí excel najít. Pro názornost přikládám excel. soubor. Moc vám děkuji za případné návrhy, sama si s tím nevím moc rady 
Příloha: 
31133_excel-rada.rar (9kB, staženo 47x)
31133_excel-rada.rar (9kB, staženo 47x)(16.4.2016 19:12)#031139
děkuji vám za reakci a omlouvám se za nejasnosti. List2 slouží k zaznamenávání změn u různých společností (např. změna kapitálu, sídla) - co řádek to nová změna. Makro by mělo sloužit k přepsání dané změny (z listu2) do tabulky v listu1, aby se změna nemusela psát dvakrát. Makro by si mělo najít podle názvu společnosti řádek, ve kterém změna v listu1 nastane a podle hodnoty sloupce D v list2 buňku se stejnou hodnotou v listu1, do které se následně přepíše změna ze sloupce E (list2). Doufám, že je to nějak možné.. 
Příloha: 31143_rada-excel.rar (12kB, staženo 39x)
citovat31143_rada-excel.rar (12kB, staženo 39x)(17.4.2016 5:34)#031144
list1 zamen nazew na: Data
list2 zamen nazew na: Zmeny
kod:
Sub Zamena()
Dim Spolecnost As String
Dim Zeme As String
Dim Adres As String
Dim TypZmeny As String
Dim Kapital As Long
Dim Data As Worksheet
Dim Zmeny As Worksheet
Dim i As Long
Dim j As Long
Set Data = ThisWorkbook.Sheets("Data")
Set Zmeny = ThisWorkbook.Sheets("Zmeny")
For i = 2 To LastUsedRow(Data, "A")
Spolecnost = Data.Cells(i, "A")
Zeme = Data.Cells(i, "B")
Adres = Data.Cells(i, "C")
Kapital = Data.Cells(i, "D")
For j = 2 To LastUsedRow(Zmeny, "A")
If Zmeny.Cells(j, "C") = Spolecnost Then
'kdyz kod znajde stejne data v slupcu E podmeni data na te ze slupca F
If Zmeny.Cells(j, "E") = Zeme Then Zeme = Zmeny.Cells(j, "F")
If Zmeny.Cells(j, "E") = Adres Then Adres = Zmeny.Cells(j, "F")
If Zmeny.Cells(j, "E") = Kapital Then Kapital = Zmeny.Cells(j, "F")
TypZmeny = Zmeny.Cells(j, "D")
'pokud kod nasel Spolecnost ne musi pokracovat
Exit For
Else:
TypZmeny = "bez zmen"
'nebo
'TypZmeny = ""
End If
Next j
'zapisujemy zmeny
Data.Cells(i, "B") = Zeme
Data.Cells(i, "C") = Adres
Data.Cells(i, "D") = Kapital
Data.Cells(i, "D") = Kapital
Data.Cells(i, "F") = TypZmeny
Next i
Set Data = Nothing
Set Zmeny = Nothing
End Sub
Function LastUsedRow(ws As Worksheet, column As String) As Long
LastUsedRow = ws.Cells(ws.Rows.Count, column).End(xlUp).Row
End Functioncitovat
list2 zamen nazew na: Zmeny
kod:
Sub Zamena()
Dim Spolecnost As String
Dim Zeme As String
Dim Adres As String
Dim TypZmeny As String
Dim Kapital As Long
Dim Data As Worksheet
Dim Zmeny As Worksheet
Dim i As Long
Dim j As Long
Set Data = ThisWorkbook.Sheets("Data")
Set Zmeny = ThisWorkbook.Sheets("Zmeny")
For i = 2 To LastUsedRow(Data, "A")
Spolecnost = Data.Cells(i, "A")
Zeme = Data.Cells(i, "B")
Adres = Data.Cells(i, "C")
Kapital = Data.Cells(i, "D")
For j = 2 To LastUsedRow(Zmeny, "A")
If Zmeny.Cells(j, "C") = Spolecnost Then
'kdyz kod znajde stejne data v slupcu E podmeni data na te ze slupca F
If Zmeny.Cells(j, "E") = Zeme Then Zeme = Zmeny.Cells(j, "F")
If Zmeny.Cells(j, "E") = Adres Then Adres = Zmeny.Cells(j, "F")
If Zmeny.Cells(j, "E") = Kapital Then Kapital = Zmeny.Cells(j, "F")
TypZmeny = Zmeny.Cells(j, "D")
'pokud kod nasel Spolecnost ne musi pokracovat
Exit For
Else:
TypZmeny = "bez zmen"
'nebo
'TypZmeny = ""
End If
Next j
'zapisujemy zmeny
Data.Cells(i, "B") = Zeme
Data.Cells(i, "C") = Adres
Data.Cells(i, "D") = Kapital
Data.Cells(i, "D") = Kapital
Data.Cells(i, "F") = TypZmeny
Next i
Set Data = Nothing
Set Zmeny = Nothing
End Sub
Function LastUsedRow(ws As Worksheet, column As String) As Long
LastUsedRow = ws.Cells(ws.Rows.Count, column).End(xlUp).Row
End Functioncitovat
Zdravím :) tak makro funguje v případě, kdy nedojde k více změn u jedné společnosti. Pokud je zaznamenáno více změn u jedné společnosti (například změna podílu a změna základního kapitálu), makro nefunguje. Bylo by možné kód (viz výše - od nunus67) poupravit tak, aby se přepsaly všechny změny, popřípadě když dojde ke změně stejné položky u jedné společnosti (dvakrát za sebou se změní základní kapitál) brát tu nejaktuálnější? Šlo by dále změněnou hodnotu, která byla přepsána z listu Zmeny do listu Data zvýraznit pro aktuální měsíc červeným písmem? (př: v dubnu by byly červeným písmem zvýrazněné změny provedené v dubnu).
Příloha: 31221_automaticky-prenos-dat-mezi-bunkami.rar (12kB, staženo 38x)
citovat31221_automaticky-prenos-dat-mezi-bunkami.rar (12kB, staženo 38x)Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články