Webnoob Juniormester
19. september 2019 - 09:43 Der er 34 kommentarer og
1 løsning

Flytte data fra celle til celle og multiply

Jeg har en meget simplet vba macro.
Private Sub Overfoer_Data_Click()

    Worksheets("Sheet1").Range("H33").Copy
    Worksheets("SHeet2").Range("E3").PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationMultiply

End Sub

Det virker hvis jeg selv skriver 24 i Sheet2!E3, men hvis jeg nu gerne vil have cellen er tom og bruger en variable i min macro, hvordan gøres så det?
Jan K Ekspert
19. september 2019 - 10:48 #1
Jeg er ikke helt klar over, hvad du ønsker? Er det bare at indholdet af Sheet2!E3 ganges med indholdet af Sheet1!H33? For så kan det gøres uden kopiering.

antal = 24
Sheets("Ark2").Range("e3") = Sheets("Ark2").Range("e3") * antal
Jan Hansen Ekspert
19. september 2019 - 10:54 #2
enig med Jan, har dog lavet noget der laver det hele om til variable!!


Option Explicit
Dim ws_1 As Worksheet, ws_2 As Worksheet
Dim Cell_1 As Range, Cell_2 As Range

' konstanter der kan tilpasses
Const sWs_1 As String = "Sheet1"
Const sWs_2 As String = "Sheet2"
Const sCell_1 As String = "E3"
Const scell_2 As String = "H33"

Const Indhold As Integer = 24
'---------//-----------'

Private Sub Overfoer_Data_Click()
    Set ws_1 = Sheets(sWs_1)
    Set ws_2 = Sheets(sWs_2)
    Set Cell_1 = ws_1.Range(sCell_1)
    Set Cell_2 = ws_2.Range(scell_2)
   
    Cell_1.Value = Indhold ' indhold insættes
   
    Cell_1.Copy
    Cell_2.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationMultiply
   
    Cell_1.Value = "" 'indhold slettes
End Sub
Jan Hansen Ekspert
19. september 2019 - 10:55 #3
ved det er over kill
Jan K Ekspert
19. september 2019 - 10:59 #4
Alternativt

Eller bedre og med de rigtige navne. så undgår du at bruge en variabel

Sheets("Sheet2").Range("e3") = Sheets("Sheet2").Range("e3") * Sheets("Sheet1").Range("H33")
Jan Hansen Ekspert
19. september 2019 - 11:04 #5
ups
Const sCell_1 As String = "H33"
Const scell_2 As String = "E3"
Webnoob Juniormester
19. september 2019 - 14:20 #6
Jeg har selvfølgelig glemt og skrive at kopieringen KUN skal ske når man klikke på en knap, som jeg har lavet.
Webnoob Juniormester
19. september 2019 - 14:55 #7
Nu har jeg kigget på dit forslag Jan og det virker ikke helt efter hensigten og jeg er desværre ikke skarp nok til selv at gennemskue det.

Jeg skal kopiere en data, som er 60timer og 15 minutter. Altså 60:15 det skal fra sheet_1!H33 til sheet_2!E3 og det skal det være et tal.

Kopiere man bare tid over en tal bliver resulteten anderledes, i mit tilfælde 2,51041666666667. For at kunne vise tiden i tal bliver jeg så nød til at gange det med 24 og så får jeg 60,25 og er det jeg skal bruge. Med min makro vil jeg så gerne automatisere at tallet bliver ganget med 24
store-morten Ekspert
19. september 2019 - 15:04 #8
Måske:
Private Sub Overfoer_Data_Click()
Sheets("Sheet2").Range("E3") = Sheets("Sheet1").Range("H33") * 24
End sub
store-morten Ekspert
19. september 2019 - 15:24 #9
Og du har sikkert en grund, til at overføre med en knap, i stedet for en formel?

På Sheet2 celle E3: =Sheet1!H33*24
Jan Hansen Ekspert
19. september 2019 - 17:44 #10
store-morten har den simple og her den med en del variable:


Option Explicit
Dim ws_1 As Worksheet, ws_2 As Worksheet
Dim Cell_1 As Range, Cell_2 As Range

' konstanter der kan tilpasses
Const sWs_1 As String = "Sheet1"
Const sWs_2 As String = "Sheet2"
Const sCell_1 As String = "H33"
Const scell_2 As String = "E3"

Const Indhold As Integer = 24
'---------//-----------'

Private Sub Overfoer_Data_Click()
    Set ws_1 = Sheets(sWs_1)
    Set ws_2 = Sheets(sWs_2)
    Set Cell_1 = ws_1.Range(sCell_1)
    Set Cell_2 = ws_2.Range(scell_2)
 
    If Not Cell_1 = "" Then
        Cell_2.Value = Cell_1.Value * Indhold
    End If
End Sub
Webnoob Juniormester
19. september 2019 - 21:23 #11
Jan din løsning er super, virke perfekt.
Nu er det kun en start på mit lille projekt og jeg håber I vil hjælpe, da jeg overhoved ikke har styr på programmering.

Nu vil jeg gerne have samme knap til at kopiere sheet1!I35:I37 til sheet2!E4:E6
og også her skal der ganges med 24.
Vil I hjælpe?
store-morten Ekspert
19. september 2019 - 21:49 #12
Nu har du ikke komenteret på #8 og 9

Så mon ikke Jan kommen med flere kode linjer ;-)

Eller kan jeg da godt prøve at tilføje de 3 linjer der skal til i #8
Jan Hansen Ekspert
19. september 2019 - 21:59 #13
Morten jo de kommer her, og er nemme at udvide (I min verden)


Option Explicit
Dim ws_1 As Worksheet, ws_2 As Worksheet
Dim Cell_1 As Range, Cell_2 As Range
Dim sCell(1 To 4, 1 To 2) As String ' 1 to 4 giver 4 rækker (øg hvis der skal bruges flere) 1,2 laver to kolonner i array'et
Dim Count As Integer

' konstanter der kan tilpasses
Const sWs_1 As String = "Sheet1"
Const sWs_2 As String = "Sheet2"

Const Indhold As Integer = 24
'---------//-----------'

Private Sub Overfoer_Data_Click()
    Set ws_1 = Sheets(sWs_1)
    Set ws_2 = Sheets(sWs_2)
   
    'fylder celleadresser ind i Array'et
'Kolonne 1
    sCell(1, 1) = "H33"
    sCell(2, 1) = "I35"
    sCell(3, 1) = "I36"
    sCell(4, 1) = "I37"
'Kolonne 2
    sCell(1, 2) = "E3"
    sCell(2, 2) = "E4"
    sCell(3, 2) = "E5"
    sCell(4, 2) = "E6"
'---------------//-----------'

    For Count = LBound(sCell_1, 1) To UBound(sCell_1, 1) ' looper gennem alle rækker i array'et
      Set Cell_1 = ws_1.Range(sCell(Count, 1))
      Set Cell_2 = ws_2.Range(sCell(Count, 2))
   
      If Not Cell_1 = "" Then
          Cell_2.Value = Cell_1.Value * Indhold
      End If
    Next
End Sub

store-morten Ekspert
19. september 2019 - 22:03 #14
I min verden er denne også nem at udvide
Private Sub Overfoer_Data_Click()
Sheets("Sheet2").Range("E3") = Sheets("Sheet1").Range("H33") * 24
Sheets("Sheet2").Range("E4") = Sheets("Sheet1").Range("I35") * 24
Sheets("Sheet2").Range("E5") = Sheets("Sheet1").Range("I36") * 24
Sheets("Sheet2").Range("E6") = Sheets("Sheet1").Range("I37") * 24
End Sub
Webnoob Juniormester
19. september 2019 - 22:17 #15
Jan jeg får en fejl med din.
"Compile error:
Variable not defined"

I linje For Count = LBound(sCell_1,1)…….. bliver sCell_1 markeret og "Private Sub Overfoer_Data_Click()" bliver markeret med gul
store-morten Ekspert
19. september 2019 - 22:29 #16
Fejler min også..... ;-)
Webnoob Juniormester
19. september 2019 - 22:38 #17
Nej morten din fejler ikke. :)
Men når jeg nu kommer dertil hvor jeg skal lave en dropdown liste ud fra mine sheets og skal kunne vælge at over data til det sheet jeg vælger i listen så skal jeg bruge Jans løsning.
Jan Hansen Ekspert
19. september 2019 - 22:51 #18
ups rettes til
  For Count = LBound(sCell, 1) To UBound(sCell, 1) ' looper gennem alle rækker i array'et
Jan Hansen Ekspert
19. september 2019 - 22:53 #19
#17
Tænkte nok du ikke havde hele opgaven beskrevet!!
store-morten Ekspert
19. september 2019 - 22:53 #20
Ala dette:
Sub Overfoer_Data_Click_mjo()

FraArk = "Sheet1"
'Rulleliste på Sheet1 celle A1
TilArk = Sheets("Sheet1").Range("A1")

Sheets(TilArk).Range("E3") = Sheets(FraArk).Range("H33") * 24
Sheets(TilArk).Range("E4") = Sheets(FraArk).Range("I35") * 24
Sheets(TilArk).Range("E5") = Sheets(FraArk).Range("I36") * 24
Sheets(TilArk).Range("E6") = Sheets(FraArk).Range("I37") * 24
End Sub
store-morten Ekspert
19. september 2019 - 23:10 #21
Skal være:
Private Sub Overfoer_Data_Click()
Dim FraArk As String, TilArk As String

FraArk = "Sheet1"
'Rulleliste på Sheet1 celle A1
TilArk = Sheets("Sheet1").Range("A1")

Sheets(TilArk).Range("E3") = Sheets(FraArk).Range("H33") * 24
Sheets(TilArk).Range("E4") = Sheets(FraArk).Range("I35") * 24
Sheets(TilArk).Range("E5") = Sheets(FraArk).Range("I36") * 24
Sheets(TilArk).Range("E6") = Sheets(FraArk).Range("I37") * 24
End Sub
Webnoob Juniormester
20. september 2019 - 12:45 #22
Tak nu virker det.
Ja Jan det ved jeg godt og beklager hvis du synes det er træls og jeg er sikkert forkert på den, men jeg vil gerne have en ting til at virke af gangen, så har jeg måske en mulighed for at se hvordan tingene gøres.

Jeg har nu selv, meget stolt, lave denne macro. Det er en dropdown list med navne på mine sheets. Listen har dog ikke navnene før jeg har været inde og køre macroen i "Vis programkode" har prøvet og få den til at virke når jeg åbner excel filen.

Sub Auto_Open()
    Dim ws As Worksheet
        For Each ws In Worksheets
        ComboBox1.AddItem ws.Name
    Next ws
End Sub
store-morten Ekspert
20. september 2019 - 13:18 #23
Det var da godt.
Men hvad/hvilken en virker?
Jan Hansen Ekspert
20. september 2019 - 13:42 #24
prøv:

Sub Auto_Open()
    Dim ws As Worksheet
    For Each ws In Workbook.Worksheets
        ComboBox1.AddItem ws.Name
    Next ws
End Sub
Jan Hansen Ekspert
20. september 2019 - 13:44 #25
evt.
kode i Denne_projekmappe

Private Sub Workbook_Open()
    Dim ws As Worksheet
    For Each ws In Workbook.Worksheets
        ComboBox1.AddItem ws.Name
    Next ws
End Sub
Jan Hansen Ekspert
20. september 2019 - 13:47 #26
Ej Træls, dog kunne det være rart at vide, da jeg så vil indrette kode anderledes, end når den ikke skal være dynamisk!
Webnoob Juniormester
20. september 2019 - 14:33 #27
Dropdown listen virker nu når jeg åbner excel filen.
Løsningen er:
I "Denne_projektmappe"
[code]
Option Explicit

Private Sub Workbook_Open()
    Sheets("Vagtplan").Drop_List1
End Sub
[/code]

og i "sheet1"
[code]
Sub Drop_List1()
    Dim ws As Worksheet
        For Each ws In Worksheets
        ComboBox1.AddItem ws.Name
    Next ws
End Sub
[/code]
Webnoob Juniormester
20. september 2019 - 14:34 #28
Nu er spørgsmålet så, hvordan bruger jeg den combobox Drop_List1 i min knap?
store-morten Ekspert
20. september 2019 - 14:38 #29
#28 Ja, det er spænende, hvilken kode kører når du trykker på knappen?
store-morten Ekspert
20. september 2019 - 14:51 #30
Prøv på Arkene:
Private Sub Worksheet_Activate()
ComboBox1.Clear
    Dim ws As Worksheet
        For Each ws In Worksheets
        ComboBox1.AddItem ws.Name
    Next ws
End Sub
Webnoob Juniormester
20. september 2019 - 14:54 #31
Beklager, men jeg er ikke så skarp til programmering.

Koden som knappen afvikler er
Option Explicit
Dim ws_1 As Worksheet, ws_2 As Worksheet
Dim Cell_1 As Range, Cell_2 As Range
Dim sCell(1 To 4, 1 To 2) As String ' 1 to 4 giver 4 rækker (og hvis der skal bruges flere) 1,2 laver to kolonner i array'et
Dim Count As Integer

' konstanter der kan tilpasses
Const sWs_1 As String = "sheet1"
Const sWs_2 As String = "sheet2"

Const Indhold As Integer = 24
'---------//-----------'

Private Sub Overfoer_Data_Click()
    Set ws_1 = Sheets(sWs_1)
    Set ws_2 = Sheets(sWs_2)
   
    'fylder celleadresser ind i Array'et
'Kolonne 1
    sCell(1, 1) = "H33"
    sCell(2, 1) = "I35"
    sCell(3, 1) = "I36"
    sCell(4, 1) = "I37"
'Kolonne 2
    sCell(1, 2) = "E3"
    sCell(2, 2) = "E4"
    sCell(3, 2) = "E5"
    sCell(4, 2) = "E6"
'---------------//-----------'

    For Count = LBound(sCell, 1) To UBound(sCell, 1) ' looper gennem alle rækker i array'et
      Set Cell_1 = ws_1.Range(sCell(Count, 1))
      Set Cell_2 = ws_2.Range(sCell(Count, 2))
   
      If Not Cell_1 = "" Then
          Cell_2.Value = Cell_1.Value * Indhold
      End If
    Next
End Sub
store-morten Ekspert
20. september 2019 - 15:02 #32
Når jeg tester overstående kode, får jeg: Compile error ?
Webnoob Juniormester
20. september 2019 - 15:05 #33
Det virker hos mig.
Jan Hansen Ekspert
20. september 2019 - 15:07 #34
prøv disse rettelser

' konstanter der kan tilpasses
Const sWs_1 As String = "sheet1"
Const sWs_2 As String = "sheet2" ' slet denne linie
dim sWs_2 as String


Const Indhold As Integer = 24
'---------//-----------'

Private Sub Overfoer_Data_Click()
    Set ws_1 = Sheets(sWs_1)
  sWs_2=ComboBox1.Value
    Set ws_2 = Sheets(sWs_2)
 
    'fylder celleadresser ind i Array'et
store-morten Ekspert
20. september 2019 - 15:12 #35
Kort og godt:
Private Sub Worksheet_Activate()
ComboBox1.Clear
    Dim ws As Worksheet
        For Each ws In Worksheets
        ComboBox1.AddItem ws.Name
    Next ws
End Sub

Private Sub Overfoer_Data_Click()
Dim FraArk As String, TilArk As String

FraArk = "Sheet1"
TilArk = ComboBox1.Value

Sheets(TilArk).Range("E3") = Sheets(FraArk).Range("H33") * 24
Sheets(TilArk).Range("E4") = Sheets(FraArk).Range("I35") * 24
Sheets(TilArk).Range("E5") = Sheets(FraArk).Range("I36") * 24
Sheets(TilArk).Range("E6") = Sheets(FraArk).Range("I37") * 24
End Sub
Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links

Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester





Premium
Test: Huaweis Matebook X er særlig laptop med en svaghed, som du skal være opmærksom på
Huawei beviser endnu en gang, at de sagtens kan mingle sig med de bedste pc-producenter. Men alligevel skyder selskabet lidt ved siden af, med sin nyeste maskine.
Computerworld
Bitcoinen nåede lige at kulminere igen – men så kom krakket
Der blev sat en ny rekord for bitcoinens værdi i år – men godt 24 timer efter blev der høvlet næsten 20.000 kroner af den.
CIO
Podcast: Her er seks gode råd om ledelse og digitalisering fra danske top-CIO'er
The Digital Edge: Vi har talt med 17 af Danmarks dygtigste digitale ledere - og samlet deres seks bedste råd om digitalisering og ledelse. Få alle rådene på 26 minutter i denne episode af podcasten The Digital Edge.
Job & Karriere
Se Waoos forklaring: Derfor har selskabet fyret topchef Jørgen Stensgaard med omgående virkning
Waaos bestyrelse opsiger fiberselskabets topchef, Jørgen Stensgaard, der fratræder med omgående virkning. Se hele forklaringen fra Waao her.
White paper
Gratis whitepaper: Hvad er EDI, og hvordan kan det styrke min forretning?
Overvejer du EDI, og ønsker du at undersøge, om EDI er den rette investering for din virksomhed? Har en af dine kunder eller leverandører for nyligt bedt dig om at udveksle elektroniske dokumenter (EDI)? Så hent dette whitepaper og få et overblik over, hvad EDI er, og hvilke fordele producenter og grossister som dig kan se frem til, når du investerer i EDI til din forretning.