Stránka 1 z 1
Excel makro - prohození hodnot dvou buněk+vlození puvodních
Napsal: 11 srp 2013 18:35
od birgis
Ahoj,
prosím excel-machry o pomoc s makrem.
Makro by mělo umět u dvou označených buněk (vždy na jiném řádku) ke každé buňce vložit komentář (případně k existujícímu komentáři přidat) hodnotu buňky (text) a text ze sloupce A u druhé označené buňky a k tomu aktuální datum změny(vložení komentáře), a potom hodnoty označených buněk prohodit.
Výsledek by měl vypadat jako v příloze
Děkuju všem za pomoc
Budu rad i za částečnou pomoc (prohození buněk, nebo jen zápis hodnot do komentáře při změně,...))
Re: Excel makro - prohození hodnot dvou buněk+vlození puvodn
Napsal: 13 srp 2013 21:01
od pavel.lasak
Zda je označeno tento kód:
Kód: Vybrat vše
Dim Bunka As Range
For Each Bunka In Selection
MsgBox "Vybraný řádek je " & Bunka.Row
MsgBox "Vybraný sloupec je " & Bunka.Column
'uloz do promene: pokus = c.Row
Next c
pak použít další kódy na přečtení, zápis
http://office.lasakovi.com/excel/vba-li ... excel-vba/
Re: Excel makro - prohození hodnot dvou buněk+vlození puvodn
Napsal: 13 srp 2013 21:25
od cmuch
Ja na to vytvořil makro, trochu delší
, ale zdá se funkční.
Buňky musí být vybrané pouze 2 a to přes ctrl, pokud tažením myši tak se to neprovede.
Kód: Vybrat vše
Sub ProhozeniKomentaru()
Dim Adresy, Adresa1, Adresa2 As Variant
Dim Coment1, Coment2 As String
Adresy = Selection.Address
If InStr(1, Adresy, ":", 1) = 0 And Selection.Count = 2 Then
Adresa1 = Mid(Adresy, 1, InStr(1, Adresy, ",", 1) - 1)
Adresa2 = Mid(Adresy, InStr(1, Adresy, ",", 1) + 1, Len(Adresy) - InStr(1, Adresy, ",", 1))
If Range(Adresa1).Comment Is Nothing Then
Range(Adresa1).AddComment
Range(Adresa1).Comment.Text Text:="Owner:" & Chr(10) & Range(Adresa1).Value & " " & Cells(Range(Adresa1).Row, "A")
Else
Range(Adresa1).Comment.Text Text:="Owner:" & Chr(10) & Range(Adresa1).Value & " " & Cells(Range(Adresa1).Row, "A")
End If
If Range(Adresa2).Comment Is Nothing Then
Range(Adresa2).AddComment
Range(Adresa2).Comment.Text Text:="Owner:" & Chr(10) & Range(Adresa2).Value & " " & Cells(Range(Adresa2).Row, "A")
Else
Range(Adresa2).Comment.Text Text:="Owner:" & Chr(10) & Range(Adresa2).Value & " " & Cells(Range(Adresa2).Row, "A")
End If
Coment1 = Range(Adresa1).Comment.Text
Coment2 = Range(Adresa2).Comment.Text
Range(Adresa1).Comment.Text Text:=Coment2
Range(Adresa2).Comment.Text Text:=Coment1
End If
End Sub
Re: Excel makro - prohození hodnot dvou buněk+vlození puvodn
Napsal: 15 srp 2013 20:08
od birgis
Ahoj,
já vím, že s budu vymýšlet moc, ale risknu,to:)
Po stisknutá klávesové zkratky by to mělo udělat několik kroků:
1: Načíst hodnoty z označení buněk
2: Ty hodnoty vložit do komentáře u stejné buňky (pokud už existuje u některé z vybraných komentář, tak přidat na další řádek)
3: Za tu hodnotu vložit jméno z řádku druhé označené buňky
4: Hodnoty v buňkách vzájemně prohodit
Je to soubor s plánovanými směnami a učel je ten, aby se zaznamenaly do komentářů prohozené směny (původní směna, s kým byl vyměněno, kdo vyměnil-místo Owner přihlášený uživatel-to se ale doplní samo při přidání komentáře)
Každopádně kdyby se ti do toho už nechtělo, tak moc děkuju i za tohle makro, třeba s pomocí dalších to dáme dohromady
Re: Excel makro - prohození hodnot dvou buněk+vlození puvodn
Napsal: 16 srp 2013 06:48
od cmuch
Tak takto
Kód: Vybrat vše
Sub ProhozeniKomentaru()
Dim Adresy, Adresa1, Adresa2 As Variant
Dim Coment1, Coment2, HodnotaBunky1, HodnotaBunky2 As String
Adresy = Selection.Address
If InStr(1, Adresy, ":", 1) = 0 And Selection.Count = 2 Then
Adresa1 = Mid(Adresy, 1, InStr(1, Adresy, ",", 1) - 1)
Adresa2 = Mid(Adresy, InStr(1, Adresy, ",", 1) + 1, Len(Adresy) - InStr(1, Adresy, ",", 1))
If Range(Adresa1).Comment Is Nothing Then
Range(Adresa1).AddComment
End If
Range(Adresa1).Comment.Text _
Text:=Range(Adresa1).Comment.Text & Chr(10) & "- " & Application.UserName & Chr(10) & Range(Adresa1).Value & " " & Cells(Range(Adresa2).Row, "A")
If Range(Adresa2).Comment Is Nothing Then
Range(Adresa2).AddComment
End If
Range(Adresa2).Comment.Text _
Text:=Range(Adresa2).Comment.Text & Chr(10) & "- " & Application.UserName & Chr(10) & Range(Adresa2).Value & " " & Cells(Range(Adresa1).Row, "A")
'Coment1 = Range(Adresa1).Comment.Text
'Coment2 = Range(Adresa2).Comment.Text
'Range(Adresa1).Comment.Text Text:=Coment2
'Range(Adresa2).Comment.Text Text:=Coment1
HodnotaBunky1 = Range(Adresa1).Value
HodnotaBunky2 = Range(Adresa2).Value
Range(Adresa1).Value = HodnotaBunky2
Range(Adresa2).Value = HodnotaBunky1
End If
End Sub
Re: Excel makro - prohození hodnot dvou buněk+vlození puvodn
Napsal: 16 srp 2013 09:02
od birgis
Tak už je to skoro ono jen jsem provedl malinké změny
Kód: Vybrat vše
Sub ProhozeniKomentaru()
Dim Adresy, Adresa1, Adresa2 As Variant
Dim Coment1, Coment2 As String
Adresy = Selection.Address
If InStr(1, Adresy, ":", 1) = 0 And Selection.Count = 2 Then
Adresa1 = Mid(Adresy, 1, InStr(1, Adresy, ",", 1) - 1)
Adresa2 = Mid(Adresy, InStr(1, Adresy, ",", 1) + 1, Len(Adresy) - InStr(1, Adresy, ",", 1))
If Range(Adresa1).Comment Is Nothing Then
Range(Adresa1).AddComment
End If
Range(Adresa1).Comment.Text Text:=Range(Adresa1).Comment.Text & Chr(10) & Application.UserName & Chr(10) & Range(Adresa2).Value & " " & Cells(Range(Adresa1).Row, "A")
If Range(Adresa2).Comment Is Nothing Then
Range(Adresa2).AddComment
End If
Range(Adresa2).Comment.Text Text:=Range(Adresa2).Comment.Text & Chr(10) & Application.UserName & Chr(10) & Range(Adresa1).Value & " " & Cells(Range(Adresa2).Row, "A")
Coment1 = Range(Adresa1).Comment.Text
Coment2 = Range(Adresa2).Comment.Text
Range(Adresa1).Comment.Text Text:=Coment2
Range(Adresa2).Comment.Text Text:=Coment1
[b]
Range(Adresa1).Value= Adresa2
Range(Adresa2).Value= Adresa1
[/b]
End If
End SubJen jsem se ještě snažil udělat ten 4 bod, tedy hodnoty v buňkách vzájemně prohodit, ale dostal jsem se jen k tomu, že mi to vrací chybu, nebo vloží adresu buňky, nebo je v obou buňkách stejná hodnota.
Re: Excel makro - prohození hodnot dvou buněk+vlození puvodn
Napsal: 16 srp 2013 11:57
od cmuch
Upraveno předchozí makro.
Vykomentoval jsem prohozeni komentářů, to tam asi být nemělo již od začátku.
Na konci je to prohození hodnot.
Ještě by asi bylo dobré ve vlastnostech komentářů zaškrtnout "automatickou velikost"
Re: Excel makro - prohození hodnot dvou buněk+vlození puvodn Vyřešeno
Napsal: 18 srp 2013 21:19
od birgis
Ahoj, tak jsem to konečně vyzkoušel a je to přesně to, co jsem potřeboval.Odkomentoval jsem a upravil ty komentáře(jen malé změny) ale je to super.
Moc děkuju za pomoc..Máš u mě panáka