Tæl sammenhængende perioder

Du får lige en lille funktion, der kan tælle som du ønsker.
Opret et modul og smid koden derind.

Private Sub Test_Tæl()
  Debug.Print
  Debug.Print Tæl(100)
End Sub

Function Tæl(ID1 As Long) As Long
  Const TabelNavn = "Perioder"
  Dim strSQL As String
  Dim DummyRst As Recordset
  Dim Antal As Long
  Dim Husk As Long
 
  Antal = 0
  strSQL = "SELECT " & TabelNavn & ".* FROM " & TabelNavn & " WHERE ID=" & ID1 & " ORDER BY Aktiv_år DESC"
  Set DummyRst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
  With DummyRst
    If Not .EOF Then
      Antal = 1
      Husk = !Aktiv_år
      .MoveNext
      If Not .EOF Then
        Do
          If !Aktiv_år = Husk - 1 Then
            Antal = Antal + 1
            Husk = !Aktiv_år
          Else
            Exit Do
          End If
          .MoveNext
        Loop Until .EOF
      End If
    End If
    .Close
  End With
  Set DummyRst = Nothing
  Tæl = Antal
End Function

Hvordan bruges modulet.

Mit output skal gemmes i en tabel hvor ID og antal år gemmes

ID er en alfanummerisk værdi

Hvis jeg forsøger at benytte modulet i en forespørgsel får jeg "expected 1" fejl ved denne linie

Set DummyRst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot

Så får du lidt mere at lege med. Bemærk at der nu er 2 tabeller i spil.

Function Tæl(ID1 As Long) As Long
  Const Tabel1Navn = "Perioder"
  Const Tabel2Navn = "Opsamling"
  Dim strSQL As String
  Dim DummyRst As Recordset
  Dim Antal As Long
  Dim Husk As Long
 
  Antal = 0
  strSQL = "SELECT " & Tabel1Navn & ".* FROM " & Tabel1Navn & " WHERE ID=" & ID1 & " ORDER BY Aktiv_år DESC"
  Set DummyRst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
  With DummyRst
    If Not .EOF Then
      Antal = 1
      Husk = !Aktiv_år
      .MoveNext
      If Not .EOF Then
        Do
          If !Aktiv_år = Husk - 1 Then
            Antal = Antal + 1
            Husk = !Aktiv_år
          Else
            Exit Do
          End If
          .MoveNext
        Loop Until .EOF
      End If
    End If
    .Close
  End With
  Set DummyRst = Nothing
  Tæl = Antal
 
  DoCmd.SetWarnings False
  If IsNull(DLookup("ID", Tabel2Navn, "ID=" & ID1)) Then
    DoCmd.RunSQL ("INSERT INTO " & Tabel2Navn & "(ID, Antal_år) SELECT " & ID1 & "," & Antal)
  Else
    DoCmd.RunSQL ("UPDATE " & Tabel2Navn & " SET Antal_år=" & Antal & " WHERE ID=" & ID1)
  End If
  DoCmd.SetWarnings True
End Function

... og i øvrigt: Du vil vel køre denne kode fra en knap el.lign. - for at få talt op og gemt antallet i din opsamlingstabel. Jeg har svært ved at se, hvordan du skulle kunne afvikle den fra en forespørgsel.

Hvis der er noget, jeg har misforstået, må du lige skitsere hvordan du havde forestillet dig fremgangsmåden.

Det er en beregning der skal laves og gemmes een gang, så en "source" og "target" tabel løsning er det jeg er ude efter

... og så opdagede jeg lige din kommentar om at ID er alfanumerisk. Her er så en tilrettet version, du kan lege med:

Private Sub Test_Tæl()
  Debug.Print
  Debug.Print Tæl("100")
End Sub

Function Tæl(ID1 As String) As Long
  Const Tabel1Navn = "Perioder"
  Const Tabel2Navn = "Opsamling"
  Dim strSQL As String
  Dim DummyRst As Recordset
  Dim Antal As Long
  Dim Husk As Long
 
  Antal = 0
  strSQL = "SELECT " & Tabel1Navn & ".* FROM " & Tabel1Navn & " WHERE ID='" & ID1 & "' ORDER BY Aktiv_år DESC"
  Set DummyRst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
  With DummyRst
    If Not .EOF Then
      Antal = 1
      Husk = !Aktiv_år
      .MoveNext
      If Not .EOF Then
        Do
          If !Aktiv_år = Husk - 1 Then
            Antal = Antal + 1
            Husk = !Aktiv_år
          Else
            Exit Do
          End If
          .MoveNext
        Loop Until .EOF
      End If
    End If
    .Close
  End With
  Set DummyRst = Nothing
  Tæl = Antal
 
  DoCmd.SetWarnings False
  If IsNull(DLookup("ID", Tabel2Navn, "ID='" & ID1 & "'")) Then
    DoCmd.RunSQL ("INSERT INTO " & Tabel2Navn & "(ID, Antal_år) SELECT '" & ID1 & "'," & Antal)
  Else
    DoCmd.RunSQL ("UPDATE " & Tabel2Navn & " SET Antal_år=" & Antal & " WHERE ID='" & ID1 & "'")
  End If
  DoCmd.SetWarnings True
End Function

OK, her lærer vi så værdien af at formulere sit spm præcist fra starten ;O)

Source og Target tabel var i øvrigt allerede indbygget. De hed bare Tabel1 og Tabel2. Jeg har omdøbt dem.
  Source indeholder ID og Aktiv_år (hhv tekst og tal)
  Target indeholder ID og Antal_år (hhv tekst og tal)

Du får en frisk version af koden - nu med en lille løkke, der løber alle ID'er igennem.

Private Sub TælAlleID()
  Const SourceTabelNavn = "Perioder"
  Const TargetTabelNavn = "Opsamling"
 
  Dim strSQL As String
  Dim DummyRst As Recordset
 
  DoCmd.SetWarnings False
  DoCmd.RunSQL ("DELETE " & TargetTabelNavn & ".* FROM " & TargetTabelNavn)
  DoCmd.SetWarnings True
 
  strSQL = "SELECT ID FROM " & SourceTabelNavn & " GROUP BY ID;"

  Set DummyRst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
  With DummyRst
    If Not .EOF Then
      Do
        Call Tæl(!ID, SourceTabelNavn, TargetTabelNavn)
        .MoveNext
      Loop Until .EOF
    End If
  End With
 
  Set DummyRst = Nothing
End Sub

Function Tæl(ID1 As String, SourceTabelNavn As String, TargetTabelNavn As String) As Long
  Dim strSQL As String
  Dim DummyRst As Recordset
  Dim Antal As Long
  Dim Husk As Long
 
  Antal = 0
  strSQL = "SELECT " & SourceTabelNavn & ".* FROM " & SourceTabelNavn & " WHERE ID='" & ID1 & "' ORDER BY Aktiv_år DESC"
  Set DummyRst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
  With DummyRst
    Antal = 1
    Husk = !Aktiv_år
    .MoveNext
    If Not .EOF Then
      Do
        If !Aktiv_år = Husk - 1 Then
          Antal = Antal + 1
          Husk = !Aktiv_år
        Else
          Exit Do
        End If
        .MoveNext
      Loop Until .EOF
    End If
    .Close
  End With
  Set DummyRst = Nothing
  Tæl = Antal
 
  DoCmd.SetWarnings False
  DoCmd.RunSQL ("INSERT INTO " & TargetTabelNavn & "(ID, Antal_år) SELECT '" & ID1 & "'," & Antal)
  DoCmd.SetWarnings True
End Function