Gå til innhold

Foto

[Løst] Forkorte makro, Excel

sette dato


3 svar i denne tråden

#1 Trelkrok

Trelkrok

    Bruker

  • Medlemmer
  • 132 innlegg
  •   4. april 2016

Skrevet 14. juli 2019 - 12:58

Hei, har Norsk Excel, Office 365

Kan denne forkortes? Eventuelt hvordan??

 

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim kol As Integer

 Dim rad As Integer

 

 Dim Tekstkol As Integer

 Dim DatoKol As Integer

 Dim TidKol As Integer

 

 'Område 1

 Tekstkol = 5

 DatoKol = 4 

 kol = Target.Column

 rad = Target.Row

 

 If kol = Tekstkol And rad > 2 Then 'Håpper over 2 rader. Raden begynner her 1, 2, eller 3

  If Target.Value <> "" Then

   If Cells(rad, DatoKol) = "" Then

    Cells(rad, DatoKol) = Left(Now(), 10)

   End If

  Else

    Cells(rad, DatoKol) = ""

    Cells(rad, TidKol) = ""

  End If

 End If

 

 'Område 2

 Tekstkol = 9

 DatoKol = 8

 kol = Target.Column

 rad = Target.Row

 

 If kol = Tekstkol And rad > 2 Then 'Håpper over 2 rader. Raden begynner her 1, 2, eller 3

  If Target.Value <> "" Then

   If Cells(rad, DatoKol) = "" Then

    Cells(rad, DatoKol) = Left(Now(), 10)

   End If

  Else

    Cells(rad, DatoKol) = ""

    Cells(rad, TidKol) = ""

  End If

 End If

 

 'Område 3

 Tekstkol = 13

 DatoKol = 12 

 kol = Target.Column

 rad = Target.Row

 

 If kol = Tekstkol And rad > 2 Then 'Håpper over 2 rader. Raden begynner her 1, 2, eller 3

  If Target.Value <> "" Then

   If Cells(rad, DatoKol) = "" Then

    Cells(rad, DatoKol) = Left(Now(), 10)

   End If

  Else

    Cells(rad, DatoKol) = ""

    Cells(rad, TidKol) = ""

  End If

 End If

 

 'Område 4

 Tekstkol = 17

 DatoKol = 16 

 kol = Target.Column

 rad = Target.Row

 

 If kol = Tekstkol And rad > 2 Then 'Håpper over 2 rader. Raden begynner her 1, 2, eller 3

  If Target.Value <> "" Then

   If Cells(rad, DatoKol) = "" Then

    Cells(rad, DatoKol) = Left(Now(), 10)

   End If

  Else

    Cells(rad, DatoKol) = ""

    Cells(rad, TidKol) = ""

  End If

 End If

 

 'Område 5

 Tekstkol = 21

 DatoKol = 20 

 kol = Target.Column

 rad = Target.Row

 

 If kol = Tekstkol And rad > 2 Then 'Håpper over 2 rader. Raden begynner her 1, 2, eller 3

  If Target.Value <> "" Then

   If Cells(rad, DatoKol) = "" Then

    Cells(rad, DatoKol) = Left(Now(), 10)

   End If

  Else

    Cells(rad, DatoKol) = ""

    Cells(rad, TidKol) = ""

  End If

 End If

 

 'Område 6

 Tekstkol = 25

 DatoKol = 24

kol = Target.Column

 rad = Target.Row

 

 If kol = Tekstkol And rad > 2 Then 'Håpper over 2 rader. Raden begynner her 1, 2, eller 3

  If Target.Value <> "" Then

   If Cells(rad, DatoKol) = "" Then

    Cells(rad, DatoKol) = Left(Now(), 10)

   End If

  Else

    Cells(rad, DatoKol) = ""

    Cells(rad, TidKol) = ""

  End If

 End If

 

 'Område 7

 Tekstkol = 29

 DatoKol = 28

 'TidKol = 2 

 kol = Target.Column

 rad = Target.Row

 

 If kol = Tekstkol And rad > 2 Then 'Håpper over 2 rader. Raden begynner her 1, 2, eller 3

  If Target.Value <> "" Then

   If Cells(rad, DatoKol) = "" Then

    Cells(rad, DatoKol) = Left(Now(), 10)

   End If

  Else

    Cells(rad, DatoKol) = ""

    Cells(rad, TidKol) = ""

  End If

 End If

 

 'Område 8

 Tekstkol = 33

 DatoKol = 32 

 kol = Target.Column

 rad = Target.Row

 

 If kol = Tekstkol And rad > 2 Then 'Håpper over 2 rader. Raden begynner her 1, 2, eller 3

  If Target.Value <> "" Then

   If Cells(rad, DatoKol) = "" Then

    Cells(rad, DatoKol) = Left(Now(), 10)

   End If

  Else

    Cells(rad, DatoKol) = ""

    Cells(rad, TidKol) = ""

  End If

 End If

 

 'Område 9

 Tekstkol = 37

 DatoKol = 36

kol = Target.Column

 rad = Target.Row

 

 If kol = Tekstkol And rad > 2 Then 'Håpper over 2 rader. Raden begynner her 1, 2, eller 3

  If Target.Value <> "" Then

   If Cells(rad, DatoKol) = "" Then

    Cells(rad, DatoKol) = Left(Now(), 10)

   End If

  Else

    Cells(rad, DatoKol) = ""

    Cells(rad, TidKol) = ""

  End If

 End If

 

 'Område 10

 Tekstkol = 41

 DatoKol = 40

kol = Target.Column

 rad = Target.Row

 

 If kol = Tekstkol And rad > 2 Then 'Håpper over 2 rader. Raden begynner her 1, 2, eller 3

  If Target.Value <> "" Then

   If Cells(rad, DatoKol) = "" Then

    Cells(rad, DatoKol) = Left(Now(), 10)

   End If

  Else

    Cells(rad, DatoKol) = ""

    Cells(rad, TidKol) = ""

  End If

 End If

 

 

End Sub

 



Beste svar Trelkrok, 15. juli 2019 - 13:22

Hei

 

Den kan forkortes betraktelig.

Men først: Target kan være et større celleområde dersom du bruker fyllhåndtaket, eller hvis du limer inn et celleområde. Da har ikke Target nødvendigvis en rad eller kolonne, og så havarerer koden.

 

Her er et par sjørøvertricks. Enten sjekke Target(1), som er cella lengst til venstre øverst i Target:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target(1).Row = 5 Then

som regel er det jo bare denne ene. Eller loope hver eneste celle i Target:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
For Each Cel In Target
    If Cel.Row = 5 Then

Du kan også sjekke om det er en eller flere celler som er endret:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then
    'flere celler

Så til spørsmålet. Hvis jeg skjønner riktig så skal hver fjerde kolonne fom E få en dato til venstre for seg hvis det ikke står en der fra før. Jeg ville løst det med Select Case slik -vi bruker den late måten og sjekker bare Target(1):

Private Sub Worksheet_Change(ByVal Target As Range)
If Target(1).Row < 3 Then Exit Sub
Select Case Target(1).Column
    Case 5, 9, 13, 17, 21, 25, 29 'fyll på videre
        If Target(1).Offset(0, -1).Value < 100 Then Target.Offset(0, -1).Value = Date
    Case Else
        'do nothing
End Select
End Sub

Beste hilsen Harald

Gå til hele innlegget

  • 0

#2 Harald Staff

Harald Staff

    Bruker

  • Medlemmer
  • 2 411 innlegg
  •   25. april 2005

Skrevet 15. juli 2019 - 10:20

Hei

 

Den kan forkortes betraktelig.

Men først: Target kan være et større celleområde dersom du bruker fyllhåndtaket, eller hvis du limer inn et celleområde. Da har ikke Target nødvendigvis en rad eller kolonne, og så havarerer koden.

 

Her er et par sjørøvertricks. Enten sjekke Target(1), som er cella lengst til venstre øverst i Target:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target(1).Row = 5 Then

som regel er det jo bare denne ene. Eller loope hver eneste celle i Target:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
For Each Cel In Target
    If Cel.Row = 5 Then

Du kan også sjekke om det er en eller flere celler som er endret:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then
    'flere celler

Så til spørsmålet. Hvis jeg skjønner riktig så skal hver fjerde kolonne fom E få en dato til venstre for seg hvis det ikke står en der fra før. Jeg ville løst det med Select Case slik -vi bruker den late måten og sjekker bare Target(1):

Private Sub Worksheet_Change(ByVal Target As Range)
If Target(1).Row < 3 Then Exit Sub
Select Case Target(1).Column
    Case 5, 9, 13, 17, 21, 25, 29 'fyll på videre
        If Target(1).Offset(0, -1).Value < 100 Then Target.Offset(0, -1).Value = Date
    Case Else
        'do nothing
End Select
End Sub

Beste hilsen Harald


  • 0

#3 Trelkrok

Trelkrok

    Bruker

  • Medlemmer
  • 132 innlegg
  •   4. april 2016

Skrevet 15. juli 2019 - 13:22   Beste svar

Hei

 

Den kan forkortes betraktelig.

Men først: Target kan være et større celleområde dersom du bruker fyllhåndtaket, eller hvis du limer inn et celleområde. Da har ikke Target nødvendigvis en rad eller kolonne, og så havarerer koden.

 

Her er et par sjørøvertricks. Enten sjekke Target(1), som er cella lengst til venstre øverst i Target:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target(1).Row = 5 Then

som regel er det jo bare denne ene. Eller loope hver eneste celle i Target:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
For Each Cel In Target
    If Cel.Row = 5 Then

Du kan også sjekke om det er en eller flere celler som er endret:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then
    'flere celler

Så til spørsmålet. Hvis jeg skjønner riktig så skal hver fjerde kolonne fom E få en dato til venstre for seg hvis det ikke står en der fra før. Jeg ville løst det med Select Case slik -vi bruker den late måten og sjekker bare Target(1):

Private Sub Worksheet_Change(ByVal Target As Range)
If Target(1).Row < 3 Then Exit Sub
Select Case Target(1).Column
    Case 5, 9, 13, 17, 21, 25, 29 'fyll på videre
        If Target(1).Offset(0, -1).Value < 100 Then Target.Offset(0, -1).Value = Date
    Case Else
        'do nothing
End Select
End Sub

Beste hilsen Harald


Dette innlegget har blitt redigert av Trelkrok: 15. juli 2019 - 13:23

  • 0

#4 Trelkrok

Trelkrok

    Bruker

  • Medlemmer
  • 132 innlegg
  •   4. april 2016

Skrevet 15. juli 2019 - 13:23

Tusen takk Harald, funker som bare det.  :)   :)   :)


  • 0


0 bruker(e) leser denne tråden

0 medlemmer, 0 gjester, 0 skjulte brukere