Klik på en celle, VB gør en funktion

Højreklik på fanen Udregning og vælg vis kode og indsæt følgende

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    'D11 : E11->E12
    If Not Intersect(Me.Range("D11"), Target) Is Nothing Then
        Me.Range("E12").Value = Me.Range("E11").Value
    End If

    'D11 : E11->E12
    If Not Intersect(Me.Range("D17"), Target) Is Nothing Then
        Me.Range("E18").Value = Me.Range("E17").Value
    End If

End Sub

Flemming Vadet >
Tak skal du have,

når jeg nu trykker på fx D11, så markere den E11

hvorfor gør den det ?

Har du mere kodning under SelectionChange(...?
F.eks. mere end de 3 linjer her under?

Har sammen skrevet koden:

Hej Morten
Ja måske 10 linjer
D11
D17
D20
D25 vider der ud af

Jeg kunne godt tænke mig, at der hvor den kopier ned

At der kommer til at være et komma og et ciffer  på så det kommer til at se sådan ud her

Fx 1,0 Time  X 100 =  200 eller 1,5  Time  X 150
Altså et komma og et ciffer ekstra på  😊

Det gør ikke noget, at være celle kopi har sin egen kode : -)

Hilsen Martin G.
Ps.
Måske  men skulle  lave en streng i VB
hvordan tager  :
C8,D8

C8 ",0" " Time X" D8 "="  C8* D8

Færdig resultat  :-)
1,0 Time  X 100 =  200

Hej Martin

Det var mere et spørgsmål om du havde andet kode der markerer celle E11 🙂

Der er en grund til at jeg ikke kommentere dit andet spørgsmål 😉

https://www.dropbox.com/s/01gd0ygwgc67nlg/Kopi%20celle.xlsm?dl=0

Hej Morten

Nåår ja, nej der ikke noget kode slet ikke 😊

Tak for dit forslag 😉 (hmm kan ikke få det til at du)

Hvis men, nu glemmer det med at Kopier celle  en til en
Kunne men så i stedet for ikke gøre, hvis men trykker på fx celle D11 så skal VB gøre en funktion

Noget i denne her stil

Worksheets("").Range("E11 ,0").Value = "" & Worksheets("").Range("C8") & "Time X " & Worksheets("").Range("D8") & " " & Worksheets("").Range("") & "=" &

Ja så strengen kommer til at se sådan ud færdig her  : -)
1,0 Time X 100 = 100

Eller sådan her  :

1,5 Time X 100 = 150

Og måske den laver en (Ctrl+c)

Så jeg helt selv manuel, kan indsætte den kopieret streng, i et anden  ark sådan her ved at trykke (Crrl+v)

Hilsen Martin 😊

Har du set #6

Hej Morten

Ja jeg har prøvet #6

hmm der sker ikke rigtig noget  : -)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not Intersect(Range("D11,D17"), Target) Is Nothing Then
        Target.Offset(1, 1).Value = _
        Target.Offset(-3, -1).Value & ",0 Time X " & _
        Target.Offset(-3, 1).Value & " = " & _
        Target.Offset(-3, -1).Value * Target.Offset(-3, 1).Value
       
    End If

End Sub
Når men trykker på D11 eller D17

Hej Martin

Det bliver rodet når du opretter nyt spørgsmål om det samme.

Jeg har rettet lidt i arket i #6 med inspiration fra det nye spørgsmål.

Når du afprøver, gør du det så i arket fra #6 ?
Eller kopierer du koden over i dit eget ark, for den går ikke ;-)

Hej Morten

Jeg har prøvet at downloade #6, hmm

Der sker ikke noget, den skulle ikke  reagere når men trykker på D11 ”den grøne celle”??? 😊

Jeg har kopier ikke koden  😊

Hmm,  hele humlen er hvis men skal kopier en celle i et ark,  over i et anden ark
Hvor fx der stå sådan en formel  her : 

=C8&" Time  X "&D8&" =  "&E8
2 Time  X 100 =  200

Den går ikke,  der bliver men nød til at først kopiere cellens indhold over i fx en notesblok for at rense cellen 😊 og kopiere teksten igen, fra notesbloken,  for at sætte ind i en anden celle

Derfor kunne det være godt at lave en funktion i VB, hvor den laver en streng i en celle, ved et tryk  på en celle

Ja en lille kode pr. firma / priser
De står lidt Hulter til bulter

I min  første tråd, tænkte jeg først på en kopi af celle ned i en anden celle
Hvor der ville sættes et komma og 0 bagefter et lige tal fx 1,0 måske en lidt svær øvelse 😊

Mit nye anden tråd, tænkte jeg

At det måske var lettere, at VB lavet en streng ved et tryk på en celle og ville sætte et komma og nul på

jens48 og Morten det er noget bøven alt sammen

måske men skulle glemme , alt om det ekstra komma og 0
at VB bare laver en kopi af den formel celle når men trykker på den grønne celle færdig bum 😊

og VB måske laver en ”Ctrl+C” så det er muligt at kopier over i et anden ark

Jeg har lige prøvet  Flemming Vadet - #1  Igen

Den gør det faktisk rigtig,  (sjovt den drillede første gang)
Var det muligt at VB lige lavet en ”Ctrl+C” af celle E12

Hilsen Martin G.

Hvis du har hentet arket i #6 og der ikke sker noget ved at klikke på den grønne celle har du et problem med din excel 🤨

Hej Morten

Der kommer de to her

Når jeg har trykkede mig igennem,  så ender det med lidt kode
Så ved ikke om der er nogen , yderligere indstillinger i Excel (Som du har lavet)  eller om der er mere kode?

klik 1
https://www.dropbox.com/s/8n5jagovwy5mqen/Pas%20p%C3%A5.jpg?dl=0

Klik 2
https://www.dropbox.com/s/y1gkxtvn2p02qik/Sikker.jpg?dl=0
Hilsen Martin

Har du lagt mærke til advarsel øverst ?

Du har åbnet arket uden aktive makro

Hej Morten
jo det har jeg  : -)
Til sidt kommer der denne kode :
når jeg har trykke mig igemmen

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not Intersect(Range("D11,D17"), Target) Is Nothing Then
        Target.Offset(1, 1) = _
        WorksheetFunction.Text(Target.Offset(-3, -1), ".0") & " Time X " & _
        Target.Offset(-3, 0) & " = " & _
        Target.Offset(-3, -1) * Target.Offset(-3, 0)
        Target.Offset(1, 1) = WorksheetFunction.Substitute(Target.Offset(1, 1), ".", ",")
    End If

End Sub

Ja, hvis du vil have det til at virke skal du have aktiiveret makroer

Hej Martin, venter spændt på om du har fået det til at virke :-)

En til rettelse af koden, prøv den i dit eget ark.
Vær ops på at den "grønne" i celle D11
bruger cellen C2 og D2 til beregning
og skriver i celle E12

Jeg har måske en løsning mere ;-)

Rettelse:
Vær ops på at den "grønne" i celle D11
bruger cellen C8 og D8 til beregning
og skriver i celle E12

Godaften Morten 
ja selvførlig
lige meget kort her fra ,  gælder mig til at prøve
er næten lige komme hjem,  og skal i seng  igen nu og her  :-)
abr vider på sagen  :-)

Jeg takker megen gangen  :-)
Hilsen Martin

Hej Morten

Nu har jeg kopieret koden direkte over i mit egen regneark


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not Intersect(Range("D11"), Target) Is Nothing Then
        Target.Offset(1, 1) = _
        WorksheetFunction.Substitute(WorksheetFunction.Text( _
        Target.Offset(-3, -1), ".0") & " Time X " & _
        Target.Offset(-3, 0) & " = " & _
        Target.Offset(-3, -1) * Target.Offset(-3, 0), ".", ",")
    End If
End Sub

hmm den skriver ikke noget
skulle den ikke gøre en funktion, når men trykker på D11

Den skulle skrive i E12 ?
fx 1,0 Time X 100 = 100

Hvor sætter du koden ind?

Hej Morten : -)

lige her 

https://www.dropbox.com/s/7qfscedj8671gcp/Kode.jpg?dl=0

Det er ikke koden fra #20
Men det burde virke

https://www.dropbox.com/s/0u4qu8fl1fla36y/Kopi%20celle%20test%203.xlsm?dl=0

Hej Morten
Tænker om der skal nogen, yderligere indstillinger i Excel?

Der sker stadig ikke noget når men fx trykker på D11

https://www.dropbox.com/s/kn3jpwk0y9b023d/Billede.jpg?dl=0
https://www.dropbox.com/s/zsbi9h5z82omkwd/Kode%201.jpg?dl=0
https://www.dropbox.com/s/kukujwh7l0l72u3/Om%20Excel.jpg?dl=0

Hilsen Martin
Ps. #1 , dur det er lidt af samme kode i de første linjer

På det første billede er Designtilstand slået til?

Prøv at slå det fra

Hej Morten  :-)

sikke en lang kamp, nu lykkes det :-)
Tak for det  :-)

spørgsmål
hvad gør denne her ?

Target.Offset(1, 1) = _
1,1?

Hilsen Martin

Hvor bestemmer den at der skal tages ting fra celler

C8, D8, E8 ?

Target = den markerede celle ( 0 )
Offset(1, 1) = række
Offset(1, 1) = kolonne

Så Target.Offset(1, 1) = cellen 1 række under og 1 kolonne til højre for Target.

Så når du trykker på D11 så skrives der i E12

Jeg har fundet en Function (kode) på nettet, der kan "åbne" for input til udklipsholderen.
Er du interesseret i den?

Så du kan trykke på: Firma navn i celle B8 og få resultatet i Udklipsholderen til indsættelse med Ctrc + V

Så men kan sige hele udgangspunktet, ligger i D11


så men styre rundt Target.Offset(-3, -1)
-3 celler op - 1 celle tilbage 

Fra  D11

"Hvor bestemmer den at der skal tages ting fra celler

C8, D8, E8 ?"

Det gør den med udgangs punt i Target(0, 0)
Jeg bruger kun C8 og D8 i koden (Timer og Pris)

Derfor celle afstand skal være ens, så sammen kode bruge hver gang.

Hvis når men trykker på D11 ”den grønne celle” at den samtidig laver en kopi til udklipsholder fra færdig resultat i E12

er der meget kode?

Nej, så man trykke på Firma i B8 og laver det færdig resultat i udklipsholder.

Oki , men kan måske ikke lave det i D11?
i samme tryk?
jeg kopiere oftest prisen ind i min kørselsrapport med det samme :-)

arket ligger i samme Excel som i min kørsel rapport :-)

Så men kan sige sådan her  :-)

    If Not Intersect(Range("D11,D17"), Target) Is Nothing Then
        Target.Offset(1, 1) = _
  E12 =    WorksheetFunction.Substitute(WorksheetFunction.Text( _
       

  C8 = Target.Offset(-3, -1), ".0") & " Time X " & _
  D8 = Target.Offset(-3, 0) & " = " & _
 
  C8*D8 = Target.Offset(-3, -1) * Target.Offset(-3, 0), ".", ",")

Prøv denne:
https://www.dropbox.com/s/hyed2051kgj5nzc/celle%20test%204.xlsm?dl=0

Godaften Morten  :-)

Tak for hjlæpen, er det lige som den gemmer i fil??
eller hvordan ?

jeg skal lige se hvordan jeg få implementerede koden :-)
Det stå lidt Hulter til bulter :-)

Nogen gangen ville der stå en anden text
Prisen med en anden text

kunne men ikke få den, skrive strengen også, som før ?

God aften 🙂

For står ikke hvad du skriver 🤔

Er måske lidt træt

hej Morten  igen  :-)

Oki , Altså  er det muligt at VB også skriver teksten i en celle samtidig :-)
Som i #17 fx

En combi :-)
https://www.dropbox.com/s/livv38s7zcqhyza/celle%20test%205.xlsm?dl=0

Huha nu sker der ikke noget igen : -)

Det skal virke 😀

Hvad har du nu trykket på

Designtilstand igen 😉

Hmm det er lige det kigger på det  :-)

hvordan kunne men få J28 til  ligne  J27?
lige den gamle kode  :-)

https://www.dropbox.com/scl/fi/msfyu0mz8gbqtlswow0kk/celle-test-4_-med-takst-pris.xlsm?dl=0&rlkey=i3562g2c4auuslonf4ftplnrb

Designtilstand er trykket ud, hmm den Kopier heller ikke eller noget

Den dur os dig ?

Hold hold  :-)  det dur for søren da men skal bare trykke på  D11,D17  :-)

for satan da :-) ved ikke engang om man må bande her

Denne her kode gemmer den på PC?


' Copy Excel value to the Windows Clipboard
Function Clipboard$(Optional s$)
    Dim v: v = s  'Cast to variant for 64-bit VBA support
    With CreateObject("htmlfile")
    With .parentWindow.clipboardData
        Select Case True
            Case Len(s): .setData "text", v
            Case Else:  Clipboard = .GetData("text")
        End Select
    End With
    End With
End Function

Flettede celler og makro kode er ikke en god combi.

Flettede celler burde ikke være opfundet.

Flettede celler, hvor er det henne?

Det er ikke godt med VB

"Denne her kode gemmer den på PC?"

Ja, til dels, gør at udklipsholder kan modtaget data.

Data sættes i udklipsholder med:
  Clipboard Target.Offset(1, 1)

E25:G25

hmm det er rigtigt  Morten
hvad med en hjælpe celle?

med hjælpe celle

https://www.dropbox.com/scl/fi/msfyu0mz8gbqtlswow0kk/celle-test-4_-med-takst-pris.xlsm?dl=0&rlkey=i3562g2c4auuslonf4ftplnrb

Prøv:

Holde da op Morten  :-) der sidder lige i skabet

jeg må lave den kode pr.  takst pris

Morten hvad nu hvis men laver en celle i være takst pris?

Fx J25 J35

kunne men ikke bruge det?

https://www.dropbox.com/scl/fi/msfyu0mz8gbqtlswow0kk/celle-test-4_-med-takst-pris.xlsm?dl=0&rlkey=i3562g2c4auuslonf4ftplnrb

If Not Intersect(Range("B25"), Target) Is Nothing Then
 
       
        Target.Offset(3, 8) =_
        Target.Offset(0, 8)  & "(" &_
        Target.Offset(0, 6) & ") - " & _
        Target.Offset(2, 2) & " X 15 min + " & _
        Target.Offset(4, 2) & " km + " & _
        Target.Offset(5, 2) & " St. gebyr = " & _
        Target.Offset(6, 3)
     
    End If
End Sub

Fik ski selv løst den  : -)

If Not Intersect(Range("B25,B37"), Target) Is Nothing Then
 
       
        Target.Offset(3, 8) = _
        Target.Offset(0, 8) & " (" & _
        Target.Offset(0, 6) & ") - " & _
        Target.Offset(2, 2) & " X 15 min + " & _
        Target.Offset(4, 2) & " km + " & _
        Target.Offset(5, 2) & " St. gebyr = " & _
        Target.Offset(6, 3)
     
    End If

Jeg ville undgå for mange hjælpe celler :-)
https://www.dropbox.com/s/ttljm0k09donia4/celle%20test%204_%20med%20takst%20pris%203.xlsm?dl=0

Hej Morten

Mangen tak skal du have, du er en genial mand :-)

Den laver fejl,  i denne her :

Clipboard Target.Offset(1, 1)

den er lidt opdateret  :-)
https://www.dropbox.com/scl/fi/n9du65myhft7wop55srp7/Mappe1_pr-ve.xlsm?dl=0&rlkey=mxol2dhpy5jg2mqnueoorsxrk

Hej Martin

Du skal have styr på dit layout.
Fordi koden tager udgangspunkt i cellen der markeres.

Det vil sige at de enkelte "Takst" områder SKAL være 100% ens.

https://www.dropbox.com/s/6idplnil9vwi7pt/Mappe1_pr%C3%B8ve%20Sk%C3%A6v.xlsm?dl=0

Hej Morten

Huha mangen tak skal du have , for din fine opsætning
ja tingene skal være 100% ellers går den ikke 

men det var fordi den lavet fejl i denne jatus kode  : -) (lige før )

ser ud som om de skal være identiske  :-)
Target.Offset(3, 8)
Clipboard Target.Offset(3, 8)

snart ved at eksperimentere med at sætte koden ind i original arket :-)
kørselsrekorden :-)