Predpokladám, že toto bude veľmi užitočná funkcia. Hlavne s tými zlúčenými bunkami.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: Priradenie hodnoty v okruhu bunky
MS Excel
Téma: Priradenie hodnoty v okruhu bunky 
Zaslal/a klokyno 1.3.2017 16:50
Ahojte,
chcem sa spýtať, je akosi možné spraviť "priradenie hodnoty v okruhu bunky"?
Napríklad premennej A dám value 5, range 3 a chcem aby to spravilo to, že priradí všetkým bunkám v okolí danej bunky, do vzdialenosti 3x3, hodnotou 5.
Prekrývanie by bolo tiež fajn, s tým, že keď je niekde vložená premenná tak ju neprepíše na číslo.
Viem, že je to asi zložité, ak vôbec možné.
Príklad akoby to malo vyzerať je v prílohe.
Ďakujem,
klokyno
Příloha: 
35198_example.xlsx (8kB, staženo 37x)
35198_example.xlsx (8kB, staženo 37x)(1.3.2017 18:03)#035203
pokusil jsem napsat kod:
Sub fillUsedRNG()
Dim Rng As Range
Dim usedC As Range
Dim rngC As Range
Dim Letter As String
Dim iRange As Integer
Dim i As Integer
Dim iVal As Integer
For i = 1 To 4
Letter = Left(Cells(i, "A"), 1)
iVal = Mid(Cells(i, "A"), 3, 1)
iRange = Right(Cells(i, "A"), 1)
For Each usedC In ActiveSheet.UsedRange
If usedC.Value = Letter Then
Set Rng = Range(usedC.Offset(-iRange, -iRange), usedC.Offset(iRange, iRange))
For Each rngC In Rng
If IsNumeric(rngC.Value) Then
rngC.Value = rngC.Value + iVal
End If
Next rngC
End If
Next usedC
Next i
End Sub
Sub clear()
Dim Rng As Range
Dim usedC As Range
Dim rngC As Range
Dim Letter As String
Dim iRange As Integer
Dim i As Integer
Dim iVal As Integer
For i = 1 To 4
Letter = Left(Cells(i, "A"), 1)
iVal = Mid(Cells(i, "A"), 3, 1)
iRange = Right(Cells(i, "A"), 1)
For Each usedC In ActiveSheet.UsedRange
If usedC.Value = Letter Then
Set Rng = Range(usedC.Offset(-iRange, -iRange), usedC.Offset(iRange, iRange))
For Each rngC In Rng
If IsNumeric(rngC.Value) Then
rngC.Value = ""
End If
Next rngC
End If
Next usedC
Next i
End Subcitovat
Sub fillUsedRNG()
Dim Rng As Range
Dim usedC As Range
Dim rngC As Range
Dim Letter As String
Dim iRange As Integer
Dim i As Integer
Dim iVal As Integer
For i = 1 To 4
Letter = Left(Cells(i, "A"), 1)
iVal = Mid(Cells(i, "A"), 3, 1)
iRange = Right(Cells(i, "A"), 1)
For Each usedC In ActiveSheet.UsedRange
If usedC.Value = Letter Then
Set Rng = Range(usedC.Offset(-iRange, -iRange), usedC.Offset(iRange, iRange))
For Each rngC In Rng
If IsNumeric(rngC.Value) Then
rngC.Value = rngC.Value + iVal
End If
Next rngC
End If
Next usedC
Next i
End Sub
Sub clear()
Dim Rng As Range
Dim usedC As Range
Dim rngC As Range
Dim Letter As String
Dim iRange As Integer
Dim i As Integer
Dim iVal As Integer
For i = 1 To 4
Letter = Left(Cells(i, "A"), 1)
iVal = Mid(Cells(i, "A"), 3, 1)
iRange = Right(Cells(i, "A"), 1)
For Each usedC In ActiveSheet.UsedRange
If usedC.Value = Letter Then
Set Rng = Range(usedC.Offset(-iRange, -iRange), usedC.Offset(iRange, iRange))
For Each rngC In Rng
If IsNumeric(rngC.Value) Then
rngC.Value = ""
End If
Next rngC
End If
Next usedC
Next i
End Subcitovat
(1.3.2017 23:55)#035211
No já v tom tuším úlohy typu předměty v el. poli, napětí, prostě kus fyziky.
Každopádně by to chtělo ujasnit, jak máje jako hledat A, B, ... a co značí a jak jsou definovány ty sloučené buňky.citovat
Každopádně by to chtělo ujasnit, jak máje jako hledat A, B, ... a co značí a jak jsou definovány ty sloučené buňky.citovat
(2.3.2017 0:19)#035212
Sub TestEpicentrum()
ActiveSheet.UsedRange.ClearContents
Call Epicentrum(Range("F5"), "A", 3, 5)
Call Epicentrum(Range("J9"), "B", 3, 2)
Call Epicentrum(Range("H5"), "C", 2, 3)
End Sub
Sub Epicentrum(Centrum As Range, Popis As String, Radius As Integer, Hodnota As _
Double)
Dim BunkaTemp As Range
Set BunkaTemp = Range("X1")
BunkaTemp = Hodnota
BunkaTemp.Copy
Centrum.Offset(-Radius, -Radius).Resize(2 * Radius + 1, 2 * Radius + _
1).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
Centrum.Value = Popis
BunkaTemp.ClearContents
End Sub
Jinak se k tomu hodí Podmíněné formátování / Barevné škály.citovat
ActiveSheet.UsedRange.ClearContents
Call Epicentrum(Range("F5"), "A", 3, 5)
Call Epicentrum(Range("J9"), "B", 3, 2)
Call Epicentrum(Range("H5"), "C", 2, 3)
End Sub
Sub Epicentrum(Centrum As Range, Popis As String, Radius As Integer, Hodnota As _
Double)
Dim BunkaTemp As Range
Set BunkaTemp = Range("X1")
BunkaTemp = Hodnota
BunkaTemp.Copy
Centrum.Offset(-Radius, -Radius).Resize(2 * Radius + 1, 2 * Radius + _
1).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
Centrum.Value = Popis
BunkaTemp.ClearContents
End Sub
Jinak se k tomu hodí Podmíněné formátování / Barevné škály.citovat
Riešenie nunus67 je skoro dokonalé. Jediné v čom nevyhovuje je, že v prípade, že napríklad z A spravím v bunkách akoby písmeno U a medzi tým spravím jednu zlúčenú bunku tak tam vždy dá hodnotu z ľavej najvyššie položenej bunke. Potreboval by som aby tam vždy ostala najvyššia hodnota nezávisle od toho na ktorej pozícii sa nachádza. A keď makro pridám do iného ako toho vzorového súboru tak ho nechce ani skompilovať, error description je "Label not defined", v tom example súbore skompiluje bez problémov.
xklnc, hodnoty sa zadávajú tak ako je to v súbore zobrazené čo je v prvom poste.
Ďakujemcitovat
xklnc, hodnoty sa zadávajú tak ako je to v súbore zobrazené čo je v prvom poste.
Ďakujemcitovat
(2.3.2017 19:11)#035233
No, nechám to být. Zadání je neúplné, styl "zadání řetězcem v řešení" bych sice zpracovat mohl, ale nechci.citovat
Hmm. No tak skúste toto. Schválne nepoviem, že sa to ovláda pravým klikom, nepoviem ... 
Skúste či na to prídete, ako ...
EDIT: Síce som asi nepochopil o čo vlastne ide, ale tu je teda aspoň návod ako to pracuje:
-pravý klik do C na krúžok aktivuje funkciu vkladania matíc do poľa kde prebiehajú prieniky (I2:BF51)
-opätovným pravým klikom sa deaktivuje umiestňovanie matíc myšou
-ak je umiestňovanie aktívne (čierna gulička), tak pravým klikom do poľa prienikov, sa pole aktualizuje, pričom dochádza aj k zlučovaniu (podľa E - počet buniek v každom smere), aj k vyfarbeniu názvu objektu a obrysu (podľa farby písma v D), zrátaniu prienikov
-prepočítanie funguje aj po stlačení tlačítka (v prípade napr. zmeny parametrov)
-pridanie nového objektu sa robí tak, vypíšete D:G a pravým klikom na C v danom riadku aktivujete umiestňovanie (viď vyššie)
Skúste či na to prídete, ako ...
EDIT: Síce som asi nepochopil o čo vlastne ide, ale tu je teda aspoň návod ako to pracuje:
-pravý klik do C na krúžok aktivuje funkciu vkladania matíc do poľa kde prebiehajú prieniky (I2:BF51)
-opätovným pravým klikom sa deaktivuje umiestňovanie matíc myšou
-ak je umiestňovanie aktívne (čierna gulička), tak pravým klikom do poľa prienikov, sa pole aktualizuje, pričom dochádza aj k zlučovaniu (podľa E - počet buniek v každom smere), aj k vyfarbeniu názvu objektu a obrysu (podľa farby písma v D), zrátaniu prienikov
-prepočítanie funguje aj po stlačení tlačítka (v prípade napr. zmeny parametrov)
-pridanie nového objektu sa robí tak, vypíšete D:G a pravým klikom na C v danom riadku aktivujete umiestňovanie (viď vyššie)
Příloha: 
35249_prieniky.zip (31kB, staženo 34x)
citovat35249_prieniky.zip (31kB, staženo 34x)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