24. oktober 2007 - 11:38Der er
52 kommentarer og 1 løsning
Hjælp til at over fører celleværdi fra et ark til andet ark
Hejsa
Jeg har oprettet en projekt mappe med en masse ark til styring af lager og produktion. ark 1 (hoved lager styring) ark 3 (ordre styring produkt 1) Ark 4 (ordre styring produkt 2) Ark 5 (ordre styring produkt 3)
Jeg har ved hjælp af eksperten spm. fået lavet nogle knapper som elegant styre indtastning af nye vare og en for ordre. Men har nu opdaget lidt problemer med at få overført nogle data fra et ark over i et andet ark. Jeg vil nu forsøge med en illustration herunder til at uddybe problem.
Ark1
Vare tekst Ny Vare Lager Æbler * Bananer * Pære * Gulerødder * Majs * Ærter *
------------------------- | Indtast antal ny vare | -------------------------
Ark3
Vare tekst Antal Behov Lager Æbler 3 * Pære 5 * Majs 6 *
-------------------------- | Indtast antal i ordre | -------------------------
Ark4
Vare tekst Antal Behov Lager Æbler 5 * Bananer 2 * Pære 5 * Gulerøder 4 * Ærter 3 *
-------------------------- | Indtast antal i ordre | -------------------------
* = angiver at der er en sammenkædet reference imellem ark således lager altid er det samme ud for hver vare. Behov = (Antal*Ordre)
Som i nok har bemærket så kan vare tekst varierer i beliggenhed af række nr og det er heri problemet bl.a ligger.
Det som jeg gerne vil have er at ved klik på knap "indtast antal i ordre" så laves udregning (Antal*ordre) = Behov Disse tal vil jeg have flyttet over i Ark1 hvor Behov trækkes fra Lager under de respektive vare tekst. Jeg tænker at man opretter en knap "udtræk fra lager" som ved klik på denne flytter behov over i Ark1 og trækker tal fra i Lager og nul stiller celler i Behov på Ark3 eller Ark4.
Hvis der er problemer med at forstå mit problem eller andet så bare spørg.
Denne side indeholder artikler med forskellige perspektiver på Identity & Access Management i private og offentlige organisationer. Artiklerne behandler aktuelle IAM-emner og leveres af producenter, rådgivere og implementeringspartnere.
Hov jeg har lavet opstilling i noteblok og har lige opdaget at * er blevet kastet rundt, det skal bemærkes at disse * skulle stå under "Lager" i alle ark
Du kunne jo godt lave din "mangler celle" rød hvis behov>beholdning, se dit forrige spm. hvor jeg havde et indlæg om formattering, format for celle F5 "celle værdi" "mindre" "0" så rød så er det nemmere/hurtigere at overser ved negativ beholdning, bare en ide ?
resultatet blev:
Sub Button3_Click() Dim v As Integer Dim ws As Worksheet On Error Resume Next skema = Array("lager liste Beatronic", "nokia", "Sony-Ericsson", "usa") kl = 4 'kolonne som behov ligger i
If MsgBox("Opdatere vareliste" & vbCrLf & _ "Er du sikker ?", vbYesNo + vbQuestion) = vbYes Then
For rk = 5 To mylastrow - 1 v = Sheets(skema(0)).Cells(rk, kl).Value 'Sheets(skema(0)).Cells(rk, kl + 2).Value = v ' kopi af beholdning For i = 1 To 3 v = v - Sheets(skema(i)).Cells(rk, kl).Value Sheets(skema(i)).Cells(rk, kl).Value = "" Next i Cells(rk, kl).Value = v Next rk End If End Sub
sjovt du lige skulle nævne det for det er jeg allerede igang med nu :o)
Er også igang med større til rette læggelse da arbejdet betød at vi måtte gøre listen identisk på alle ark og derefter skjule de ting som ikke var relevant på nogle ark. resultat er absolut til at leve med.
Det er rigtigt der er lidt arbejde der, men når en vare ændres/tilføjes er det hurtigt tjent ind.
prøv forresten denne ordre, så skulle du være fri for at indtastet sidste række for ordre Sub Nokia_Knap1_Klik() ' indlæs ordre skema = Array("lager liste Beatronic", "nokia", "Sony-Ericsson", "usa") ordre = Application.InputBox("Indtast ordre ", , , , , , , 1) startRk = Application.InputBox("Start i række ", , 5, , , , , 1) 'SlutRk = Application.InputBox("Slut i række ", , 59, , , , , 1) mylastrow = Sheets(skema(0)).Cells(Sheets(skema(0)).Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For i = startRk To mylastrow - 1 Cells(i, 4).Value = (Cells(i, 2).Value * ordre) 'opdatere behov
Next i MsgBox ("Der er sat " & ordre & " i ordre ") End Sub
Kan lige nævne så at jeg har ændret lidt så rk total er 77
Sub Nokia_Knap1_Klik() ' indlæs ordre skema = Array("lager liste Beatronic", "nokia", "Sony-Ericsson", "usa") ordre = Application.InputBox("Indtast ordre ", , , , , , , 1) startRk = Application.InputBox("Start i række ", , 5, , , , , 1) 'SlutRk = Application.InputBox("Slut i række ", , 77, , , , , 1) mylastrow = Sheets(skema(0)).Cells(Sheets(skema(0)).Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For i = startRk To mylastrow - 1 Cells(i, 4).Value = (Cells(i, 2).Value * ordre) 'opdatere behov Next i MsgBox ("Der er sat " & ordre & " i ordre ") End Sub
sig mig engang hvad foregår der her....kan man slet ikke kopiere noget over i kommentar og så ændre i det??? da jeg sendte det så kom min kommentar slet ikke op men det gjore din sidst kommentar.
hmmm, lidt for tidligt med nisser på spil vil jeg sige
Sub Nokia_Knap1_Klik() ' indlæs ordre skema = Array("lager liste Beatronic", "nokia", "Sony-Ericsson", "usa") ordre = Application.InputBox("Indtast ordre ", , , , , , , 1) startRk = Application.InputBox("Start i række ", , 5, , , , , 1) 'SlutRk = Application.InputBox("Slut i række ", , 77, , , , , 1) mylastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For i = startRk To mylastrow - 1 Cells(i, 4).Value = (Cells(i, 2).Value * ordre) 'opdatere behov Next i MsgBox ("Der er sat " & ordre & " i ordre ") End Sub
ja undskyld, jeg ikke lige fik sagt "tak for idag", fik pludselig travlt. :O(
Jeg er rimelig sikker på at du har en ukorrekt værdi i en af dine celler, nok kolonne B
prøv denne forberedt kode, giver besked om linie det er galt + du kan sige anullere til indtastningsboksene
On Error GoTo out
ordre = Application.InputBox("Indtast ordre ", , , , , , , 1) startrk = Application.InputBox("Start i række ", , 5, , , , , 1) If ordre = False Or startrk = False Then Exit Sub End If mylastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row For i = startrk To mylastrow - 1 Cells(i, 4).Value = (Cells(i, 2).Value * ordre) 'opdatere behov Next i MsgBox ("Der er sat " & ordre & " i ordre ") Exit Sub out: Debug.Print i MsgBox ("Der er fejl i læsning af data. (variabel i = " & i & ")")
Jeg har lige forsøgt mig med den nye kode, og den melder at der er noget galt med linie 62, problemet er bare at linie 62 egentlig ikke findes på ark, dvs det gør den men den er skjult, dog tror jeg ikke at det er det som er fejlen, jeg har på fornemmelsen af at du i din kode angiver at det kun er 1 active sheet, hvilket jeg så tolker som kun en A4 side, men tabelen eller listen som jeg har kører videre på en side 2 da vi var nød til at få alle emner med på en liste. Men det er jo kun gætteri :o)
P.s har sandelig også lært at paste nu ;o), men er altså stadig sikker på at nisserne er tidligt ude i år.
nå ok, syntes bare det var lidt for mærkeligt at det lige var linie 62 som er er den første linie i ny side, men anyway så fandt jeg også ud af at kode også kører på skjulte linier og dvs dermed også på linier hvor der slet ikke burde være noget, så kunne man ikke indsætte en if sætning som gør at de skjulte linier ligesom bliver sprunget over af koden, dvs at koden ligesom læser den active celle i active ark før den smider resultat. Fejl i line 62 kunne derfor være at jeg i den celle rk 2 linie 62 har en tekst på, og det kan kode måske ikke tyde.
Jeg kunne jo følgelig godt bare slette linie 62 og 63, men så er det bare besværligt når man printer skema ud at man ikke kan se hvad de enkelte kolonner hedder.
det man skulle have var en if sætning som angav at hvis der ingen tal er i enkelt celle i rk 2 så skal den springe videre, på den måde ungår man vel også at den smider et stort "nul" over i cellen i rk. 4.
Jeg prøvede lige at slette teksten i rk2 og rk 4 linie 62 og så virkede kode.
ordre = Application.InputBox("Indtast ordre ", , , , , , , 1) startrk = Application.InputBox("Start i række ", , 5, , , , , 1) If ordre = False Or startrk = False Then Exit Sub End If mylastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row For i = startrk To mylastrow - 1 Cells(i, 4).Value = (Cells(i, 2).Value * ordre) 'opdatere behov Next i MsgBox ("Der er sat " & ordre & " i ordre ")
Undskyld men er det ikke den samme kode som du smed ind 20:41 igår??? Anyway den virker fint, når bare tekst er væk fra linie 62 og hvis man ser bort fra at den smider "0" ind i tomme felter i rk 4
det var næste det samme, bortset fra on error resume next
Denne springer over skjulte felter: ' indlæs ordre On Error Resume Next ordre = Application.InputBox("Indtast ordre ", , , , , , , 1) startRk = Application.InputBox("Start i række ", , 5, , , , , 1) mylastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For i = startRk To mylastrow - 1 If Rows(i & ":" & i).EntireRow.Hidden = False Then Cells(i, 4).Value = (Cells(i, 2).Value * ordre) 'opdatere behov End If Next i MsgBox ("Der er sat " & ordre & " i ordre ")
Bingo, der var den, det virker, nu har jeg så lige opdaget at "opdater" knappen istedet smider "0" i tomme celler på Lager listen, kan vi bruge samme function i "opdater" functionen.
Jeg prøvede lige selv med en if sætning, sådan her
Sub Button3_Click() Dim v As Integer Dim ws As Worksheet On Error Resume Next skema = Array("lager liste Beatronic", "nokia", "Sony-Ericsson", "usa") Kl = 4 'kolonne som behov ligger i
If MsgBox("Opdatere vareliste" & vbCrLf & _ "Er du sikker ?", vbYesNo + vbQuestion) = vbYes Then
For Rk = 5 To mylastrow - 1 If IsNumeric(Cell) Then ' tager kun nummeriske celler v = Sheets(skema(0)).Cells(Rk, Kl).Value End If For i = 1 To 3 v = v - Sheets(skema(i)).Cells(Rk, Kl).Value Sheets(skema(i)).Cells(Rk, Kl).Value = "" Next i Cells(Rk, Kl).Value = v Next Rk End If End Sub
Men den virker ikke, nok fordi jeg ikke er nogen ørn til det her, men mener bare at have set en if sætning som indholder functionen til at læse kun nummeriske celler
For Rk = 5 To mylastrow - 1 If IsNumeric(Sheets(skema(0)).Cells(rk, kl)) Then v = Sheets(skema(0)).Cells(Rk, Kl).Value For i = 1 To 3 v = v - Sheets(skema(i)).Cells(Rk, Kl).Value Sheets(skema(i)).Cells(Rk, Kl).Value = "" Next i Cells(Rk, Kl).Value = v end if Next Rk
hmm, det lyder mærkeligt, prøvede det lige, her virker det fint. Jeg har dog ikke dit ark på denne maskine, skal se om jeg kan nå det imorgen. er det forresten en dansk excel du har?
Ja det er en dansk excel version 2003 jeg har, men mener da at det burde være det samme med formater, hverenten den er dansk eller engelsk og VBA kode er jo altid i engelsk, så kan ikk lige se nogen hindring der, men nu siger du at det virker fint hos dig, det får mig til at tænke på om du måske har en eller anden fast instiling som bi virker at det virker hos dig. Jeg har prøvet mig lidt frem og tilbage med at ændre format på tal og flytte komma og alt det, indtil videre har intet af det hjulpet.
Jeg har lige forsøgt mig på tomt ark med alm. formel og der kan den godt regne det ud med simpel standard formatering i tal. Så måske der er et eller andet i koden som gør at komma tal ikke regnes. Men det sjove jeg lige netop har fundet ud af er at komma tal som 0,1 eller 0,25 regnes slet ikke, hvorderimod komma tal som 1,25 eller 3,9 regnes men resultat bliver rundet op. Måske jeg skulle sende dig min seneste version så du selv kunne se med egne øjne.
version er på vej til dig nu. Fatter slet ikke, hvorfor, jeg har godt nok alm. standard indstillinger på min excel, men det burde jo egentlig også række.
Det ved jeg sgu godt nok ikke, det nye ark virker perfekt hos mig.
f.eks ark usa ordre=2 så bliver linie 21 = 0,44
du kan evt. prøve at sætte denne ekstra linie ind, ellers må jeg give fortabt :o(
For i = startRk To mylastrow - 1 If Rows(i & ":" & i).EntireRow.Hidden = False Then Cells(i, 4).Value = (Cells(i, 2).Value * ordre) 'opdatere behov Cells(i, 4).NumberFormat = "#,##0.00" End If Next i
Ja, det er mærkeligt, men nu kigger du vel det rigtige sted?? f.eks udregning i ark "Nokia" regner fint nok behovet ud altså ordre=2 så bliver linie 21 0,44...sådan skal det også være, men det er på ark "Hoved Lager liste" at linie 21 ikke bliver rigtigt udført. Men hvis den gør det hos dig så er jeg ret sikker på at der er nisser her!!! ;o)
dvs at det snare er noget med "opdater" knappen Sub Button3_Click() Dim v As Integer Dim ws As Worksheet On Error Resume Next skema = Array("Hoved Lager liste", "nokia", "Sony-Ericsson", "usa") Kl = 4 'kolonne som behov ligger i
If MsgBox("Vil du udtrække Ordre fra Lager" & vbCrLf & _ "Er du sikker ?", vbYesNo + vbQuestion) = vbYes Then
For Rk = 5 To mylastrow - 1 If IsNumeric(Sheets(skema(0)).Cells(Rk, Kl)) Then v = Sheets(skema(0)).Cells(Rk, Kl).Value For i = 1 To 3 v = v - Sheets(skema(i)).Cells(Rk, Kl).Value Sheets(skema(i)).Cells(Rk, Kl).Value = "" Next i Cells(Rk, Kl).Value = v End If Next Rk
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
