kunde
Isaan Rules WFF CCC
If you walked away smiling-then for you the price was right
Keep Exceling
Suosikkibändit/artistit: Queen, Rammstein, genesis, Bruce Bringsteen, Kino, Mandref Mann Earth band Who
Lempikirjat: ohjelmointi...
Suosikkipalstat Suomi24 Keskusteluissa: EXCEL, Kivitalot, EPS
En pidä: pakkanen ja loskakelit
Ruoka & juoma: loimulohi ja valkkari
Linkit: http://www.kundepuu.com, Khorat
Koulutus: ---
Ammatti: Tiede/teknologia
Työskentelen: freelancer
Ase tai siviilipalvelus: yliluutnantti
Siviilisääty: Varattu
Lapset: ---
Hakusanat: Thaimaa, korat, Excel, VBA, ACAD, CNC, Polyurea, EPS, MgO elementti
Liittynyt sitten
Muokkaa profiilia7 aloitusta · 1377 kommenttia
- Toki sen voi koodata ottamaan nimen siitä solusta, mutta ei mielestäni järkevää(koska tarvitaan sitten lisätä virheen tarkasteluja yms). The Simple the Best!
Tee kuten neuvoin, eli nimeä alue otsikoineen ja ja käytä ALUEIDEN nimä koodissa. Koodi käyttää alueen nimeä ja sen ensimmäistä solua vasemmasta yläkulmasta.
Koodissa siis "nimi", "osoite" ja " email" vastaavat määritettyjen aluieden nimiä ja klikkaamalla alueen vasemmanpuoleisinta solua otsikkorivillä esim. koodissa osoite alueen ( Range("osoite").Cells(1)) ) solua, koodi suoritetaan...
Toki voi sen muuttaa koskemaan alueen koko otsikkoriviäkin.
ko. tauukon moduuliin...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("nimi").Cells(1)) Is Nothing Then
If Selection.Count = 1 Then
If Range("nimi").Cells(2, 1).EntireRow.Hidden = True Then
Range("nimi").Offset(1).Resize(Range("nimi").Rows.Count - 1).EntireRow.Hidden = False
Else
Range("nimi").Offset(1).Resize(Range("nimi").Rows.Count - 1).EntireRow.Hidden = True
End If
Target.Offset(0, 1).Select
End If
End If
If Not Intersect(Target, Range("osoite").Cells(1)) Is Nothing Then
If Selection.Count = 1 Then
If Range("osoite").Cells(2, 1).EntireRow.Hidden = True Then
Range("osoite").Offset(1).Resize(Range("osoite").Rows.Count - 1).EntireRow.Hidden = False
Else
Range("osoite").Offset(1).Resize(Range("osoite").Rows.Count - 1).EntireRow.Hidden = True
End If
Target.Offset(0, 1).Select
End If
End If
If Not Intersect(Target, Range("email").Cells(1)) Is Nothing Then
If Selection.Count = 1 Then
If Range("email").Cells(2, 1).EntireRow.Hidden = True Then
Range("email").Offset(1).Resize(Range("email").Rows.Count - 1).EntireRow.Hidden = False
Else
Range("email").Offset(1).Resize(Range("email").Rows.Count - 1).EntireRow.Hidden = True
End If
Target.Offset(0, 1).Select
End If
End If
'jne
End Sub
Keep EXCELing
@Kunde - "Allaoleva koodi ko. moduuliin..."
eli koodi pitää olla ko taulukon moduulissa eikä tavallisessa moduulissa.... - höpö höpö...
katso koodini, ja siinä voit lisätä ja poistella soluja alueelta ja toimii ;-)
Keep EXCEling
@Kunde - Unohdin mainita, että näytä/piilotus toimii klikkaamalla alueen vasemmanpuoleista solua alueen otsikkorivillä
keep EXCELing
@Kunde - Tietenkin...
maalaa dataa sisältävä alue otsikkorivineen ja nimeä se ( kirjoittamalla valinnan nimi vasemmalla ylhäällä kaavarivillä olevaan nimiruutuun (nimi koodissa) ja ENTER tai menun kautta )
Allaoleva koodi ko. moduuliin...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("nimi").Cells(1)) Is Nothing Then
If Selection.Count = 1 Then
If Range("nimi").Cells(2, 1).EntireRow.Hidden = True Then
Range("nimi").Offset(1).Resize(Range("nimi").Rows.Count - 1).EntireRow.Hidden = False
Else
Range("nimi").Offset(1).Resize(Range("nimi").Rows.Count - 1).EntireRow.Hidden = True
End If
Target.Offset(0, 1).Select
End If
End If
End Sub
Keep EXCELing
@Kunde - 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 - 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 - 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 - 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 - Sama härikkö jo pitemmän aikaa ollut asialla
- 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 - " etsisi solun oikealta vasemmalle"
Etkä osaa lukeakaan enää?
Esitä nyt ihmeessä fiksumpi kaava soluun kuin =EtsiOikealta2(A1;"/")
Function EtsiOikealta2(solu As Range, Merkki As String) As Integer
EtsiOikealta2 = InStrRev(solu, Merkki)
End Function - " etsisi solun oikealta vasemmalle"
Taidat olla itse lukihäiriöinen häirikkö.
Säälittävää, että ennen tämäkin oli asialinen ketju, mutta nykyään kaltaistesi osaamattomien naljailu ja vittuilu ketju ja et pysty muuta apua antamaan kuin vittuilua
Esitä jotain kaavoja /kaavoja ratkaisuksi, äläkä vaan vittuile.
Mikä on pointtisi vittuilulle(eli et osaakaan EXCELiä)?
Alla oleva etsii OIKEALTA VASEMMALLE ja yritäpäs tehdä se fiksummin (toki kun et ymmärrä koodista mitään, tehtävä mahdoton ja vittuillet lisää sitten)...
Function EtsiOikealta2(solu As Range, Merkki As String) As Integer
EtsiOikealta2 = InStrRev(solu, Merkki)
End Function - Pistä minun amatöörin VBA koodit paremmaksi jos osaat ja nuo 3 antaa täsmälliset vastaukset .
Luulen, että vajaat 20 v tänne ratkaisuja postanneena olen amatööriä paremmin perillä asioista.
Ennen ei ollut tommosia tyhjän paskan jauhajia vaan asiallisia postauksia
Nykyäänhän täällä viime vuosina on vain näitä anonyymi trollaajia, jotka eivät pysty muuhun kuin vittuilemaan eikä vastaamaan kyssäreihin ja sepeävät muihin ohjelmiin jne.. - Aloittaja kysyi /moi/terve
ja vastasin siihen...
tossa VBA käyttäjän funktioita
soluun kaavat
=EtsiOikealta(A1;"/")
=EtsiOikealta2(A1;"/")
=EtsiOikealta3(A1;"/")
Function EtsiOikealta(solu As Range, Merkki As String) As Integer
EtsiOikealta = Len(solu) - InStr(1, StrReverse(solu), Merkki) 1
End Function
Function EtsiOikealta2(solu As Range, Merkki As String) As Integer
EtsiOikealta2 = InStrRev(solu, Merkki)
End Function
Function EtsiOikealta3(solu As Range, Merkki As String) As Integer
'helposti vaikkapa toka vika esiintymä...
x = InStrRev(solu, Merkki)
EtsiOikealta3 = InStrRev(solu, Merkki, x - 1)
End Function
Keep EXCELing
@Kunde - Turhan monimutkaista...
soluun kaava
=ETSI("/";A1;2)
monimutkaisempiin sitten VBA
ja iellä esim . SPLIT, LIKE jne
Keep EXCELing
@Kunde - 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 - Esim solussa -100,11 ja solumuotiluina
# ##0;-€ # ##0 näytetään -€ 100
# ##0,00;-€ # ##0,00 näytetään -€ 100,11
keep EXCELing
Kunde - Esim solussa -100,11 ja solumuotiluina
# ##0;-€ # ##0 näytetään -€ 100
# ##0,00;-€ # ##0,00 näytetään -€ 100
keep EXCELing
Kunde - räätälöity suojaus "3 ~ s ä h k ö" taulukkoon
ThisWorkbook moduuliin...
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Worksheets("3 ~ s ä h k ö").Unprotect Password:="Kunde"
End Sub
Private Sub Workbook_Open()
Worksheets("3 ~ s ä h k ö").Protect Password:="Kunde", DrawingObjects:=False, Contents:=True, Scenarios:=True
Worksheets("3 ~ s ä h k ö").EnableSelection = xlUnlockedCells
End Sub
Keep EXCELing
@Kunde