Avatar billede timtoftgaard Praktikant
20. november 2005 - 13:26 Der er 4 kommentarer og
1 løsning

Flytning af kolonne

Jeg måler nogle data, hvor jeg til sidst i en macro i visual basic, får flyttet måledata hen i et opsamlingsark (=Ark2). Data står herefter i ark2, hvor der automatisk i række 1 står dato og derefter i række 2 til række 70 står data. Ved næste måling kommer data i næste kolonne osv.
Jeg vil nu gerne automatisk have data (række 2 til række 70)flyttet til en nyt ark (f.eks. ark 3),men sammen med den række (f.eks række m) skal rækken  før (række n) også flyttes med på samme måde.
Det betyder, at der efter mine løbende målinger hver gang står de to sidste rækker fra ark 2 ind i ark 3 (række a og række b)
Er der en let løsning enten:
1) en kode i ark 3, som siger at der altid skal stå de sidste rækker fra ark 3
2) udbygning af min macro ?

mvh
Tim Toftgaard
Avatar billede timtoftgaard Praktikant
21. november 2005 - 19:11 #1
"Gammel" macro og se evt gammelt spørgsmål http://exp.dk/spm/642054


Public RunWhen As Double
Public cRunIntervalSeconds  ' one minutes
Public Const cRunWhat = "TheSub"
Public I As Long


Public SlutTid As Date ' NY linie


Sub Pico()
Dim AntalGange As Integer ' NY linie
AntalGange = 70
If I = 0 Then
cRunIntervalSeconds = 1
ElseIf I >= 1 And I < AntalGange Then ' Rettet
cRunIntervalSeconds = 1
Else
cRunIntervalSeconds = 1
End If
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
    schedule:=True
  '----------------------------------------------
  If I > 0 Then
  SlutTid = Now() + (TimeSerial(0, 0, 1) * ((AntalGange - I) * cRunIntervalSeconds))
  Sheets("Ark1").Range("F1") = SlutTid - Now()  ' NY linie
  End If
  '----------------------------------------------
 

End Sub

Sub TheSub()
If I = 0 Then
Sheets("Ark1").Columns("A:A").ClearContents
End If
  I = I + 1
  If I > 70 Then
      Call StopTimer
      Call Flyt
      MsgBox "Kopiering slut & data overført"
      Exit Sub
  End If
Sheets("Ark1").Range("A" & I) = Sheets("Ark1").Range("D1") ' Navn på hovedark
  Call Pico
End Sub

Sub StopTimer()
I = 0
  On Error Resume Next
  Application.OnTime earliesttime:=RunWhen, _
      procedure:=cRunWhat, schedule:=False
End Sub
Public Sub Flyt()
' ret arknavnet til dit ark
If Sheets("Ark2").Range("A1") = "" Then
A = 1
ElseIf Sheets("Ark2").Range("B1") = "" Then
A = 2
Else
A = Sheets("Ark2").Range("A1").End(xlToRight).Offset(0, 1).Column
End If
Sheets("Ark2").Cells(1, A) = Now()
For pp = 2 To 70
Sheets("Ark2").Cells(pp, A) = Sheets("Ark1").Range("A" & pp - 1).Value
Next

'kopierer N1, N2, N3, P1, P2, P3 fra ark(Sekant)


X = 1
For pp = 73 To 83
Sheets("Ark2").Cells(pp, A) = Sheets("start").Range("C" & X).Value
X = X + 1
Next


End Sub
Avatar billede kabbak Professor
21. november 2005 - 19:41 #2
rettet i denne

Public Sub Flyt()
' ret arknavnet til dit ark
If Sheets("Ark2").Range("A1") = "" Then
A = 1
ElseIf Sheets("Ark2").Range("B1") = "" Then
A = 2
Else
A = Sheets("Ark2").Range("A1").End(xlToRight).Offset(0, 1).Column
End If
Sheets("Ark2").Cells(1, A) = Now()

Sheets("Ark3").Cells(1, "B") = Sheets("Ark2").Cells(1, A) ' Dato sidste kolonne
Sheets("Ark3").Cells(1, "A") = Sheets("Ark2").Cells(1, A - 1) ' Dato næst sidste kolonne

For pp = 2 To 70
Sheets("Ark2").Cells(pp, A) = Sheets("Ark1").Range("A" & pp - 1).Value

    Sheets("Ark3").Cells(pp, "A") = Sheets("Ark2").Cells(pp, A - 1).Value  ' Næst sidste kolonne
    Sheets("Ark3").Cells(pp, "B") = Sheets("Ark2").Cells(pp, A) ' Sidste kolonne
   
Next
'kopierer N1, N2, N3, P1, P2, P3 fra ark(Sekant)
X = 1
For pp = 73 To 83
Sheets("Ark2").Cells(pp, A) = Sheets("start").Range("C" & X).Value
X = X + 1
Next
End Sub
Avatar billede timtoftgaard Praktikant
21. november 2005 - 19:57 #3
Ved første forsøg så det sku ud til at virke.....................

Jeg tester videre og jeg melder tilbage

Tim
Avatar billede timtoftgaard Praktikant
22. november 2005 - 17:01 #4
Alt virker. Det er sku utrolig så let du kan klare mine problemer.
Tak for hjælpen.
Send et svar, så du kan få point

mvh
Tim
Avatar billede kabbak Professor
22. november 2005 - 17:02 #5
et svar ;-))
Avatar billede 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. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

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