Forskelige makro hjælp søges.

har fundet denne løsning til 1. men er der ikke en nemmere måde af gøre det på? så jeg ikke skal lave en for hver celle.?

Public Sub Nulstil()
    Application.ScreenUpdating = False
    For Each cc In Range("A1:A3,B1:B3")
        cc.Value = ""
    Next
   
    Application.ScreenUpdating = False
    For Each cc In Range("C1:C1")
        cc.Value = "=B1*A1"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("C2:C2")
        cc.Value = "=B2*A2"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("C3:C3")
        cc.Value = "=B3*A3"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("D1:D1")
        cc.Value = "=C1*B1"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("D2:D2")
        cc.Value = "=C2*B2"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("D3:D3")
        cc.Value = "=C3*B3"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("E1:E31")
        cc.Value = "=D1/C1+B1+A1"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("E2:E2")
        cc.Value = "=D2/C2+B2+A2"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("E3:E3")
        cc.Value = "=D3/C3+B3+A3"
        Next
       
    Application.ScreenUpdating = True
    MsgBox "Nulstilling udført"
End Sub
    Application.ScreenUpdating = False
    For Each cc In Range("E1:E1")
        cc.Value = "=D1/C1+B1+A1"
        Next
       
    Application.ScreenUpdating = True
    MsgBox "Nulstilling udført"
End Sub

VDR: #1 sætter den lige ordenligt ind:

Public Sub Nulstil()
    Application.ScreenUpdating = False
    For Each cc In Range("A1:A3,B1:B3")
        cc.Value = ""
    Next
   
    Application.ScreenUpdating = False
    For Each cc In Range("C1:C1")
        cc.Value = "=B1*A1"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("C2:C2")
        cc.Value = "=B2*A2"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("C3:C3")
        cc.Value = "=B3*A3"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("D1:D1")
        cc.Value = "=C1*B1"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("D2:D2")
        cc.Value = "=C2*B2"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("D3:D3")
        cc.Value = "=C3*B3"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("E1:E31")
        cc.Value = "=D1/C1+B1+A1"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("E2:E2")
        cc.Value = "=D2/C2+B2+A2"
        Next
       
    Application.ScreenUpdating = False
    For Each cc In Range("E3:E3")
        cc.Value = "=D3/C3+B3+A3"
        Next
       
    Application.ScreenUpdating = True
    MsgBox "Nulstilling udført"
End Sub

Sub Nulstil()
    Application.ScreenUpdating = False
        Range("A1:B3").Clear
            Range("C1") = "=B1*A1"
            Range("D1") = "=C1*B1"
            Range("E1") = "=D1/C1+B1+A1"
                Range("C1:E1").AutoFill Destination:=Range("C1:E3"), Type:=xlFillDefault
    Application.ScreenUpdating = True
    MsgBox "Nulstilling udført"
End Sub

Alternativ - sletter kun celler uden formel:

Sub test()
    For Each cc In Range("A1:A4")
        If cc.HasFormula = False Then
            cc.Value = ""
        End If
    Next cc
End Sub

Hvis kun indtastning skal nulstilles:

I A1:B3 er der ingen formler?
Er der en grund til at du vil skrive formlerne i C1:E3 igen?

#Store-morten når jeg tænker over det så nej, behøver den ikke skrive det igen, men hjælper mig med af forstå lidt af det bedre jo mere jeg leger med det :).

GodkenderSort koden, gør ikke helt hvad jeg vil have,
har fundet en ligne jeg skal bruge i den som er:

    Sub TEST123()
    If (Range("D1") + Range("E1")) <> 0 Then
        Range("I8").Value = Range("I8").Value + 1

men der ved skal den fks. teksten skal være rød fra starten af, når man så køre koden, skal teksten blive sort, (der skal ikke være msgbox på) og så må man meget gerne kun kunne godkende de dage som har været der/samme dag, men aldrig nogle dage vi ikke er nået til.



#Supertekst en super kode som jeg faktisk kan bruge til noget af det jeg skal opbygge i excel. da den virker nemmere end den anden kode.

Koden gennem løber område B1:F31.
Skal den det det?

Koden springer tomme over.
Skal den det det?

Når koden finde en celle med sort tekst.
Hvad skal den så?

Når koden finde en celle med rød tekst.
Hvad skal den så?

#Store-morten

må meget gerne springe tomme celler over.

til fks.

A1      B1      C1              D1                E1
787    221    173927    38437867    1229  <-- teksten er rød.

Laver jeg en figur og trykker på den så den køre koden, skal teksten blive sort.
der ved af denne del skal gøre:

    Sub TEST123()
    If (Range("D1") + Range("E1")) <> 0 Then
        Range("I8").Value = Range("I8").Value + 1

er at den skal tælle hvor mange gange der bliver trykket på figuren, som så røger over under figuren. jeg har set det i et excel ark et sted på nettet, men ja, gemte ikke koden da jeg ikke kunne tyde det den gang, :).

Koden gennem løber område B1:F31.
Skal den det det?

i dette tilfælde A1:B3 (da det er et test afk, jeg laver koden om når jeg bruger det i det rigtige ark) - sidder med et test ark da der er privat info i det rigtige ark jeg er i gang med. (så nemmere af sende et test ark hvis det var det der skulles ske på et tidspunkt ;))

Prøv:

Lille rettelse: Række der behandles.

#Store-Morten det var sådan jeg havde tænkt mig, det kunne være godt hvis man kunne tilføje i F1:31 datoere, og af de dage der ikke har været der kunne godkendes. men ved ikke lige om det er muligt :)?

Update med:

3. pt. jeg er nået til. men ville gerne have den til af logger tal/bogstaver så den ikke logger selve formler.

Sub Logge_Data
Application.ScreenUpdating = False

    Sheets("Ark1").Range("G6").Copy
    Sheets("Ark2").Activate
    Range("A10000").End(xlUp).Offset(1, 0).Activate
    ActiveCell.PasteSpecial

    Application.CutCopyMode = False
    Sheets("Ark1").Activate
    Range("A1").Select
Application.ScreenUpdating = True

End Sub

4. Pt. jeg er nået med denne formel, men kunne godt tænke mig af den gemmer selv på min nas server, samt med af den kun gemmer fra A1:G40 i PDF fil så jeg ikke får alle de der figure med, (ved ikke om det er muligt. og evt. den altid printer A1:G40. så den ikke spørger ikke om hvilket ark.

Public Sub XLS_Til_Pdf_Print()
Dim stiNavn As String, filNavn As String, fil As String, sti As String
Dim temp As Variant, xlsObj As Object

    stiNavn = Application.GetOpenFilename          'ønskede fil udpeges
    temp = Split(stiNavn, "\")
    filNavn = temp(UBound(temp))
    temp = Split(filNavn, ".")
    fil = temp(0)
    temp = Split(stiNavn, filNavn)
    sti = temp(0)                  'kan erstattes af anden sti
   
    Set xlsObj = CreateObject("Excel.application")
    xlsObj.Workbooks.Open stiNavn
   
    xlsObj.ActiveWorkbook.Sheets(Array("Ark1", "Ark2", "Ark3")).Select
   
    xlsObj.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        sti & fil & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    xlsObj.Application.Quit
    Set xlsObj = Nothing
   
Dim Iprint As String
    Iprint = InputBox("hvilket ark skal printes?", , 0, 100, 100)
   
    If Iprint = "1" Then
        Sheets("Ark1").Activate
        Sheets("Ark1").PrintOut Copies:=1, Collate:=True
    End If
   
    If Iprint = "2" Then
        Sheets("Ark2").Activate
        Sheets("Ark2").PrintOut Copies:=1, Collate:=True
    End If
    End Sub

Sender du dit test ark?
Adr. under profil

#Store-morten.

mail sendt.

Prøv:

Den er perfekt hvis den springer tomme celler over :).

tomme celler?
I række?

Sub GodkenderTest()
For Each c In Range("B1:F31")
c.Activate
'Hvis cellen er "tom" springes til næste celle
    If c.Value = "" Then GoTo Tom
'Række der behandles
rk = c.Row
    'Hvis cellen ikke har farve 3 (Rød)
    If Not c.Font.ColorIndex <> 3 Then
    'Hvis D+E ikke er 0 og "Dato" ikke forekommet
      If Range("D" & rk) + Range("E" & rk) <> 0 And Range("F" & rk) < Now Then
      'Ændres Font farve til "Automatisk"
      c.Font.ColorIndex = -4105
      Else
      If Range("F" & rk) = "" Then GoTo Tom
      MsgBox "Active celle kan ikke godkendes"
        End If
        End If
Tom:
    Next c
'Celle I8 tæller 1 op
Range("I8").Value = Range("I8").Value + 1
End Sub

yup, hvis der kommer en tom celle i en hel række, skal den bare springes over.

Den er god :) den du linkede til sidst.

punkt 3. Prøv med:

Sub Logge_Data()
Application.ScreenUpdating = False

    Sheets("Ark1").Range("G6").Copy
    Sheets("Ark2").Activate
    Range("A10000").End(xlUp).Offset(1, 0).Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Application.CutCopyMode = False
    Sheets("Ark1").Activate
    Range("A1").Select
Application.ScreenUpdating = True
End Sub

præcis sådan jeg ville have den til :p

jeg sidder lige og leger med =SLÅ.OP til af hente de dataer som der bliver logge, men det driller skam :)

punkt 3. Kort ;-)

Sub Logge_Data_2()
Set x = Sheets("Ark1").Range("G6")
Sheets("Ark2").Range("A10000").End(xlUp).Offset(1, 0) = x.Value
End Sub

kan jeg se :p. - jeg har brug for en der logger data, og så når den logger igen, skal den "gemme" i samme celle. så hvis den gemmer 505 og næste gang den gemmer er 1596 skal den være i samme celle som "505" så den faktisk bare sletter 505 og overføre 1596 :), er det muligt,

og har du en ide til af overføre fks. K1:O31 (det er 31 celler ned af og 5 rækker data) - kan ikke få =HVIS.FEJL(LOPSLAG( eller =SLÅ.OP til det :p

Sub Logge_Data_3()
Set x = Sheets("Ark1").Range("G6")
Sheets("Ark2").Range("A2") = x.Value
End Sub

Skal K1:O31 overføres/logges på samme måde?

K1:O31 er noget der er blevet logged' i ark2.
nu skal man kunne hente det igen til ark1.

Så på Ark1 celle? skal der hentes data fra Ark2 celle?
Med markro eller formel? (Lopslag eller andet)
En celle af gangen eller alle på en gang?

Gerne med makro hvis det er nemmere.
eller nu starter vi lige forfra, for det fylder lidt mere end K1:031.

Ark1:

der er data i alle celler/rækker så det ser sådan ud: A1:O70
de er så blevet logget til ark2 i cellerne: A1:O70
nu skal vi/jeg prøve se af flytte dem fra ark2 til ark1.
fks. ved af skrive "januar" sted så den henter fra den mdr.

så næste mdr jeg logger ark1 til ark2 så det ser sådan ud: A145:O70 og der ved hvis jeg vil hente kan man skrive "februar" og så logges det bare videre der ud af,

Ser på det og vender tilbage.

bare iorden. jeg prøver stadig af lege med det selvom det driller :)

en der kan forklare om man kan sætte fks: ark1, A1:E31 så det er kun det der bliver gemt i PDF og bliver printet ud?

Public Sub XLS_Til_Pdf_Print()
Dim stiNavn As String, filNavn As String, fil As String, sti As String
Dim temp As Variant, xlsObj As Object

    stiNavn = Application.GetOpenFilename          'ønskede fil udpeges
    temp = Split(stiNavn, "\")
    filNavn = temp(UBound(temp))
    temp = Split(filNavn, ".")
    fil = temp(0)
    temp = Split(stiNavn, filNavn)
    sti = temp(0)                  'kan erstattes af anden sti
   
    Set xlsObj = CreateObject("Excel.application")
    xlsObj.Workbooks.Open stiNavn
   
    xlsObj.ActiveWorkbook.Sheets(Array("Ark1", "Ark2", "Ark3")).Select
   
    xlsObj.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        sti & fil & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    xlsObj.Application.Quit
    Set xlsObj = Nothing
   
Dim Iprint As String
    Iprint = InputBox("hvilket ark skal printes?", , 0, 100, 100)
   
    If Iprint = "1" Then
        Sheets("Ark1").Activate
        Sheets("Ark1").PrintOut Copies:=1, Collate:=True
    End If
   
    If Iprint = "2" Then
        Sheets("Ark2").Activate
        Sheets("Ark2").PrintOut Copies:=1, Collate:=True
    End If
    End Sub

Prøv at finde "Vis sideskift"
Træk den 'blå' ramme til højre, så der kun udskrives 1 side.

Rammen til højte skal trækkes til venstre ;-)

Her med sikkerhed mod "Fejl indtastning"