30. april 2008 - 12:41Der er
9 kommentarer og 1 løsning
Hente data fra én arkfane til andre arkfaner i Excel
Jeg har et excelark som indeholder data fra nogle målinger. Der er ialt 20 målepunkter, som hver har deres egen arkfane. Da jeg ønsker at slippe for at åbne hver enkelt arkfane, hver gang jeg skal indtaste dato for måling samt måleresultat, har jeg oprettet en arkfane, hvor jeg kan indtaste dato samt måleresultat for hver af de 20 målinger.
Jeg ønsker nu at hente de indtastede data ind i hver af de respektive arkfaner, således at når dette er gjort "renses" indtastningsarket så det er klar til næste gang.
Gøres dette nemmest vha. en makro? i så fald er der nogle der har et bud på koden til en sådan?
Da der ved hver indtastning er tale om en ny dato er det vigtigt at dataene, når de hentes ind i de respektive arkfaner, hver gang hentes ind på en ny linje
Jo der er angivet målepunkt. Hvordan får jeg oprettet en makro som godt nok flytter værdier fra de samme felter, men hver gang sætter dem ind på ny linje i de respektive faner?
Rem Koden anbringes i IndtastningsArket Rem Aktiveres med Alt+F8 - Opdaterindtastning - eller forbindes med knap Rem ==================================================================== Const startRæk = 1 Const antalMålepunkter = 20 Const indtastningsArkNavn = "indtastningsArk" Dim mpArk Public Sub opdaterIndtastning() Dim mDato, mVisning Dim næsteRække For ræk = startRæk To startRæk + antalMålepunkter - 1 Rem er målepunktet udfyldt If Cells(ræk, 1) <> "" Then mpNavn = Cells(ræk, 1) 'målepunkts-id = ArkNavn mDato = Cells(ræk, 2) 'dato for måling mVisning = Cells(ræk, 3) 'visning
Rem aktiver målepunkts-arket Set mpArk = ActiveWorkbook.Sheets(mpNavn) ' With mpArk mpArk.Activate næsteRække = findNæsterække
With mpArk .Cells(næsteRække, 1) = mDato .Cells(næsteRække, 2) = mVisning End With End If ActiveWorkbook.Sheets(indtastningsArkNavn).Activate Next ræk
Rem Clear indtastningsark Cells.ClearContents End Sub Private Function findNæsterække() mpArk.Activate
With ActiveSheet For r = 1 To 65000 If .Cells(r, 1) = "" Then findNæsterække = r Exit Function End If Next r End With End Function
Nu kan jeg ikke lægge et svar her - men det du gør, er at oprette et nyt spørgsmål under samme kategori under navnet "Point til Supertekst". Dette besvarer jeg så - og herefter accepterer du så dette svar.
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.