Suoraan asiaan.
Esimerkiksi rivillä 5 minulla on kaksi solua: A5 ja A6.
A5 olisi solu, johon tulisi yhteenlaskun lopputulos ja A6 olisi solu, johon
syötetään yhteenlaskettava luku. A6 olisi siis solu, joka aina tyhjennetään
ennen uuden luvun syöttämistä ja A5 solu laskisi edellisen luvun ja
A6 soluun syötetyn luvun yhteen.
Eli A6 soluun syötetyt luvut laskettaisiin yhteen A5 solussa.
Luonnollisesti A5 solu olisi voitava tarvittaessa tyhjentää.
Toimitus vaikuttaa yksinkertaiselta, mutta harmaat aivosoluni eivät taivu
tekemään tarvittavaa kaavaa tälle, vai meneekö VB:n puolelle ongelma!?
Esimerkiksi rivillä 5 minulla on kaksi solua: A5 ja A6.
A5 olisi solu, johon tulisi yhteenlaskun lopputulos ja A6 olisi solu, johon
syötetään yhteenlaskettava luku. A6 olisi siis solu, joka aina tyhjennetään
ennen uuden luvun syöttämistä ja A5 solu laskisi edellisen luvun ja
A6 soluun syötetyn luvun yhteen.
Eli A6 soluun syötetyt luvut laskettaisiin yhteen A5 solussa.
Luonnollisesti A5 solu olisi voitava tarvittaessa tyhjentää.
Toimitus vaikuttaa yksinkertaiselta, mutta harmaat aivosoluni eivät taivu
tekemään tarvittavaa kaavaa tälle, vai meneekö VB:n puolelle ongelma!?
Vastaukset 22
Vanhimmat
Eipä ole rivillä 5 sinulla samassa sarakkeessa kahta solua.
Joudut siis pähkäilemään trollisi uudelleen.
Ähh.. kiitos tarkalle Anonyymille huomiosta. En ole siis trolli, vaan ratkaisua etsivä -Anonyymi itsekin.
Eli edelleen rivi 5, mutta solut A5 ja B5. :)
Vaikea ymmärtää että mikä on ongelma. Jokainen solu tyhjentyy jos sen tyhjentää.
Tarkoitus olisi helpottaa yhteenlaskemista, eli syöttämällä vaihtelevia lukuja soluun B5, jolloin yhteen laskettu (aiempi A5 ja uusi B5) luku summautuisivat A5 solussa.
Kyllähän solut saa tyhjäksi, mutta samalla häviää mahdollinen kaava solusta.
Eli A5 solun luku kasvaa sitä mukaa, kun B5 soluun syötetään uusi luku.
Nyt kun mietin, tämä saattaakin olla puhtaasti VB ratkaisu. Kaavalla taitaa joutua ottamaan kolmannenkin solun käyttöön, että onnistuisi.
Ko taulukon moduuliin...
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B5")) Is Nothing Then
If IsNumeric(Range("B5")) Then
Range("A5") = Range("A5") Range("B5")
End If
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'nollaa solut A5 ja B5 klikkaamalla hiiren oikealla solussa A5, ei pakollinen proseduuri
'helpottaa vaan resetointia ,-)
If Not Intersect(Target, Range("A5")) Is Nothing Then
Range("B5") = ""
Range("A5") = ""
Range("B5").Activate
Cancel = True
End If
End Sub
Keep EXCELing
@Kunde
Kiitos Kunde. Treenailin tyhjällä työkirjalla ja toimii hienosti!
Minkälainen olisi koodi muodoltaan, jos laajentaisin sen kattamaan useita rivejä, esim A5-A50 ja B5-B50?
t. Tarvetta olisi
Private Sub Worksheet_Change(ByVal Target As Range)
'voi lisätä useampiakin solualueita
'muista lisätä resetointi kanssa hiiren oikean koodiin
'If Not Application.Intersect(Target, Union(Range("B5:B50"), Range("D6:D10"), Range("F6:F15"))) Is Nothing Then
If Not Application.Intersect(Target, Range("B5:B50")) Is Nothing Then
If IsNumeric(Target) Then
Application.EnableEvents = False
Target.Offset(0, -1) = Target Target.Offset(0, -1)
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'nollaa solut A5 ja B5 klikkaamalla hiiren oikealla solussa A5, ei pakollinen proseduuri
'helpottaa vaan resetointia ,-)
If Not Application.Intersect(Target, Range("A5:A50")) Is Nothing Then
Application.EnableEvents = False
Target = ""
Target.Offset(0, 1) = ""
Target.Offset(0, 1).Activate
Application.EnableEvents = True
Cancel = True
End If
End Sub
Keep EXCELing
@Kunde
Ai saakutti sentään, onpa mahtavaa saada tällä palstalla näin toimivaa apua ongelmaan! Tämäkin toimii kuin se vanha tuttu junan vessa. ;D
Tämä tulee 3D -tulostusmaailmaan filamenttikelojen kulutusseuranta-Exceliin. Eipä tarvitse enää kaivaa calkulaattoria koneelta eikä laatikosta, kun tämän voi integroida taulukon jatkeeksi.
Tällä erää minulle riittää tämä, osaan tästä jatkaa varmaan eteenpäin.
Iso kiitos Kunde!
Kunde, pystyykö tuon B-sarakkeen yksittäisten solujen tyhjentämisen ehdollistaa esim. Ctrl tai Alt -näppäimen ja hiiren klikkauksen TAI tuplaklikkauksen alle? Tämä siksi, että tyhjennys olisi jotenkin harkitumpi ja hallitumpi. Ainakin kuvittelisin niin. :)
Ps. Käytössä olevassa taulukossani on A ja B -sarakkeiden sijaan K7:K59 ja L7:L59 käytössä, jos tiedolla on jotain merkitystä VB:n suhteen.
-Aloittaja
ko taulukon moduuliin...
Private Sub Worksheet_Change(ByVal Target As Range)
'voi lisätä useampiakin solualueita
'muista lisätä resetointi kanssa hiiren oikean koodiin
'If Not Application.Intersect(Target, Union(Range("B5:B50"), Range("D6:D10"), Range("F6:F15"))) Is Nothing Then
If Not Application.Intersect(Target, Range("L7:L59")) Is Nothing Then
If IsNumeric(Target) Then
Application.EnableEvents = False
Target.Offset(0, -1) = Target Target.Offset(0, -1)
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'nollaa solut A5 ja B5 klikkaamalla hiiren oikealla solussa A5, ei pakollinen proseduuri
'helpottaa vaan resetointia ,-)
If Not Application.Intersect(Target, Range("K7:K59")) Is Nothing Then
Application.EnableEvents = False
Target = ""
Target.Offset(0, 1) = ""
Target.Offset(0, 1).Activate
Application.EnableEvents = True
Cancel = True
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'nollaa solut A5 ja B5 klikkaamalla hiiren oikealla solussa A5, ei pakollinen proseduuri
'helpottaa vaan resetointia ,-)
If Not Application.Intersect(Target, Range("K7:K59")) Is Nothing Then
'Application.EnableEvents = False
'Target = ""
'Target.Offset(0, 1) = ""
'Target.Offset(0, 1).Activate
'Application.EnableEvents = True
'Cancel = True
End If
End Sub
tavalliseen moduuliin...
Fiksaa näppäinyhditelmä sopivaksi
Sub TeePikanäppäinMakrolle()
'tekee pikanäppäimen makrolle CtrlShiftA
'ohje https://docs.microsoft.com/en-us/office/vba/api/excel.application.onkey?f1url=?appId=Dev11IDEF1&l=en-US&k=k(vbaxl10.chm133180);k(TargetFrameworkMoniker-Office.Version=v16)&rd=true
' nyt Ctr Shift A ("^ A"), tee haluamasi yhdistelmä
Application.OnKey "^ A", "CtrlShiftA"
End Sub
Sub CtrlShiftA()
If Not Application.Intersect(ActiveCell, Range("K7:K59")) Is Nothing Then
Application.EnableEvents = False
ActiveCell = ""
ActiveCell.Offset(0, 1) = ""
ActiveCell.Offset(0, 1).Activate
Application.EnableEvents = True
Cancel = True
End If
End Sub
Keep EXCELing
@Kunde
Hyvin näyttää pelittävän, kiitos kovasti!
En vielä ota sitä käyttöön, joten se odottaa moduulissa disabloituna.
Tämän pikakomentotoiminnon olin kohdistanut L -sarakkeen 7-59 -soluille ja tein huomion, että tämän makron tyhjennys vaikuttaa myös M -sarakkeen soluihin tyhjentävästi, eli tässä M -sarakkeen soluissa mulla on kaavat, joita ei pitäisi poistaa.
Pystyykö tuohon vaikuttamaan koodillasi?
Sub CtrlShiftA()
If Not Application.Intersect(ActiveCell, Range("K7:K59")) Is Nothing Then
Application.EnableEvents = False
ActiveCell = ""
ActiveCell.Offset(0, 1) = ""
ActiveCell.Offset(0, 1).Activate
Application.EnableEvents = True
Cancel = True
End If
End Sub
Tämä alkuperäinen koodi tyhjentää K sarakkeen aktiivisen solun ja sen oikeanpuoleisen solun L- sarakeesta.
Miten haluat sen toimivan?
Nyt ilmoitit koodissa kohdistaneesi sen L- sarakkeeseen, joten luonnollisesti se poistaa sillon kaavan M- sarakkeen solusta...
1. Haluatko syötön jälkeen L- sarakkeessa tyhjennyksen pelkästään L- sarakkeen aktiivisesta solusta automaattisesti ilman pikanäppäilyä?
2. Tyhjentää pikanäppäilyllä K- sarakkeessa olemmista ssarakkeista (K ja L) rivin solut (resetointi)?
3. Jotai muuta?
Keep EXCELing
@Kunde
Taitaa tuo sinun1. tai 3. vaihtoehto.. rupesin oikein miettimään miten haluaisin tuon :))
Varmaan viisainta avata ja selkeyttää taulukkoani.
Käytössä siis edelleen rivit 7-59 (tällä hetkellä) ja työstämisen alla on pelkästään K ja L sarakkeet siten, että kun lisään L-sarakkeen soluun luvun, summautuu se K-sarakkeen luvun kanssa (jos siellä on mitään). Jos ei ole, niin luku kopioituu K-sarakkeen soluun, kuten se nyt tekeekin.
Ajattelen toimivuutta "yksinkertaisin silmin", eli K-sarakkeelle luvut saa jäädä, kunnes itse tyhjennän ne perinteisesti. Ei siis mitään poistoautomaattia K-sarakkeelle.
L-sarakkeeseen viimeisin lisätty luku voi jäädä kertomaan mikä luku viimeksi lisättiin ja senkin tyhjentäminenkin onnistuu toisaalta perinteisesti, mutta tämä ei ole niin oleellista tällä hetkellä työstää. Voin tyhjentää sen käsinkin.
M-sarakkeessa mulla on kaava, joka ei välttämättä tarvitse olla juuri siinä sarakkeessa Jos sen siirtämisestä on hyötyä, teen sen.
Kunde, jelppasit mua tällä vb-koodilla Excel-probleemassa. Homma toimii hienosti, mutta jos yritän hiiren kakkosella lisätä (vasemmasta reunasta) uuden rivin ko. solualueelle, saan alla olevan herjan, eikä riviä voi lisätä! Pystyykötähän saamaan korjausta? :))
Ps. En ole ottanut toistaiseksi hiirellä Ctrl solun tyhjennys-ominaisuutta käyttöön.
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
x Run-time error ´1004´ x
x Application-defined or object-defined error x
x x
x -Continue- -End- -Debug- -Help- x
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Private Sub Worksheet_Change(ByVal Target As Range)
'voi lisätä useampiakin solualueita
'muista lisätä resetointi kanssa hiiren oikean koodiin
'If Not Application.Intersect(Target, Union(Range("B5:B50"), Range("D6:D10"), Range("F6:F15"))) Is Nothing Then
If Not Application.Intersect(Target, Range("L7:L59")) Is Nothing Then
If IsNumeric(Target) Then
Application.EnableEvents = False
Target.Offset(0, -1) = Target Target.Offset(0, -1)
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'nollaa solut A5 ja B5 klikkaamalla hiiren oikealla solussa A5, ei pakollinen proseduuri
'helpottaa vaan resetointia ,-)
If Not Application.Intersect(Target, Range("K7:K59")) Is Nothing Then
Application.EnableEvents = False
Target = ""
Target.Offset(0, 1) = ""
Target.Offset(0, 1).Activate
Application.EnableEvents = True
Cancel = True
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'nollaa solut A5 ja B5 klikkaamalla hiiren oikealla solussa A5, ei pakollinen proseduuri
'helpottaa vaan resetointia ,-)
If Not Application.Intersect(Target, Range("K7:K59")) Is Nothing Then
For Each Cell In Range("K7:K59")
If Cell.Row = Selection.Row And Selection.Count >= 256 Then GoTo virhe
Next
Application.EnableEvents = False
Target = ""
Target.Offset(0, 1) = ""
Target.Offset(0, 1).Activate
Application.EnableEvents = True
Cancel = True
End If
Exit Sub
virhe:
Application.EnableEvents = True
Cancel = False
End Sub
Keep EXCELing
@Kunde
Kunde, sorry, että kesti vastaaminen! Kiitos taas, nyt onnistuu lisäämään uusia rivejä ko. solualueen sisälle.
t. säikeen aloittaja
Kyllähän tuon meni tottuneesti läpi, ei ilmeisesti ollut sinulta ensimmäinen kerta, tehdä kysymys, vastata siihen, ja kiitellä sitten päälle itseään.
..mitäs ihmeen soraääniä nämä on..? Voiko joku oikeesti noin huonosti..! :(
Sama härikkö jo pitemmän aikaa ollut asialla
Ei ole ollut pitemmän aikaa, eilen kirjoitin ja ennustin näin käyvän. Niin ja vielä vähemmän häirikkö. En olisi osallistunut eilenkään, mutta huomasin sinun haukkuvan väärää kaveria "turpojuntti" haukkumanimellä, koska aiemin olet tuota haukkumasanaa käyttänyt minua loukataksesi, päätin ottaa osaa ja kertoa että haukut menee väärään osoitteeseen.
Ketjuhan oli:
https://keskustelu.suomi24.fi/t/17384266/etsi-oikealta
En taatusti ole turpojuntiksi haukkunut.
Luepas tarkemmin kommentit...
Anonyymi
07.04.2022 16:02
Ilmeisesti et ole koskaan tehnyt Exelillä mitään järkevää, etkä osaa ratkaista ongelmia yleisellä tasolla.
Minäkin ratkaisin ongelman näin, joku toinen oli nopeampi.
soluun =Rfind(A1,"/")
Function Rfind(Teksti, Merkki) As Integer
Rfind = InStrRev(Teksti, Merkki)
End Function
Itse_opiskellut_amatööri
toinen anonyymi vastasi...
Älä nyt enempää itseäsi tee pelleksi, turpojuntti. Mokasit heti alkumetreillä, eikä se moka selittämällä enää korjaudu.
Itse postaan omalla tunnarillani Kunde.
En taatusti ole turpojuntiksi haukkunut.
Luepas tarkemmin kommentit...
Anonyymi
07.04.2022 16:02
Ilmeisesti et ole koskaan tehnyt Exelillä mitään järkevää, etkä osaa ratkaista ongelmia yleisellä tasolla.
Minäkin ratkaisin ongelman näin, joku toinen oli nopeampi.
soluun =Rfind(A1,"/")
Function Rfind(Teksti, Merkki) As Integer
Rfind = InStrRev(Teksti, Merkki)
End Function
Itse_opiskellut_amatööri
toinen anonyymi vastasi...
Älä nyt enempää itseäsi tee pelleksi, turpojuntti. Mokasit heti alkumetreillä, eikä se moka selittämällä enää korjaudu.
Itse postaan omalla tunnarillani Kunde.
P.S. lähti anonyyminä toi edellinen postaus vahingossa