Summe auslesen aus Access-Datenbank

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Stefan,
ich habe mir eine Mini Acces-DB angelegt und deine Daten dort hineinkopiert.
Wenn die Daten so sortiert kommen, wie in deinem Beispiel, dann tut es das beigefügte Makro, nachdem du Pfad, DB-Name und Zieltabellenblatt angepasst hast.

'
'   mein Anliegen betrifft das Auslesen eine Tabelle aus einer Access-Datenbank,
'   die Tabelle enthält Daten in der Form
'
'   Anschluss Minuten
'   7115555   20
'   7115555   60
'   7115555   40
'   8789999   80
'   8789999   85
'   8789999   60
'   5555544   35
'   5555544   26
'
'   Jetzt würde ich gern über eine Abfrage die Summen der Anschlüsse auslesen,
'   so dass folgendes Ergebniss angezeigt wird:
'
'   7115555   120
'   8789999   225
'   5555544   61
'
'   Nochmal kurz zusammengefasst, ich möchte, dass die Abfrage den Job einer
'   Pivot-Tabelle erledigt.
'
'
'   Achtung der Verweis auf: Microsoft ActiveX Data Objects 2.0 Library
'   oder eine höhere Version (2.1, 2.5) muss aktiviert sein.
'
Public Sub Zusammenfassen()
Dim Connect    As Connection  ' die Verbindung zu Access
Dim RecSet     As Recordset   ' der Access RecordSet
Dim SQLString  As String      ' der SQL Befehl
Dim Ziel       As Worksheet   ' Excel-Tabellenblatt
Dim Zeile_Q    As Integer     ' Zeile Quelle
Dim Zeile_Z    As Integer     ' Zeile Ziel
Dim Spalte     As Integer     ' Spalte
Dim DBPfad     As String      ' Pfad der Access-Anwendung
Dim DBDatei    As String      ' Name der Access-Datei bzw. DB
Dim DBTab      As String      ' Name der Access-Tabelle
Dim Anschluss  As String      ' der Ordnungsbegriff
Dim Minuten    As Long        ' die zu addierenden Minuten
   DBPfad = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Access-DBs\"
   DBDatei = "Test-DB.mdb"
   DBTab = "Stefan"

   Set Ziel = Worksheets("Tabelle5")   ' Ziel Tabellenblatt in Excel

'  Die Datenbank öffnen
   Set Connect = New ADODB.Connection
   With Connect
      .Provider = "Microsoft.Jet.OLEDB.4.0"   ' für Access 2000 und höhere
      .ConnectionString = "Data Source=" & DBPfad & DBDatei
      .Open
   End With
'
'  ******************************************************************************
'  im SQL-String definieren was geholt werden soll => hier verschiedene Varianten
'  ******************************************************************************
'
'    hier alles - die komplette Access-Tabelle

   SQLString = "SELECT " & DBTab & _
                ".* FROM " & DBTab & "" ' <-- Hier die Datenbanktabelle


   If SQLString = "" Then
      MsgBox "hier ist der Wurm drin, der SQLString ist leer - Abbruch.", _
         16, "   der SQLString wurde nicht gefüllt."
      Exit Sub
    Else
      'MsgBox SQLString      ' den SQL-String anzeigen
   End If

   Set RecSet = New ADODB.Recordset
   RecSet.Open SQLString, Connect, adOpenDynamic, adLockReadOnly

   Cells.ClearContents    ' den alten Inhalt löschen
   Call Kopf_entfaerben   ' die alten KopfZeile_Qn entfernen

   Application.ScreenUpdating = False

'  Die Feldnamen der Datenbanktabelle in die erste Zeile_Q des
'           Excel Ziel-Tabellenblattes schreiben
   For Spalte = 0 To RecSet.Fields.Count - 1
      Ziel.Cells(1, Spalte + 1) = RecSet.Fields.Item(Spalte).Name
   Next Spalte

   'Call Kopf_farbig(RecSet.Fields.Count) ' die neuen KopfZeile_Qn farbig, fett

'  Jetzt alle selektierten Sätze holen und in das Excel-Tabellenblatt schreiben
   Zeile_Q = 1
   If RecSet.EOF = False Then  ' kein EOF => es gibt also Daten !
      RecSet.MoveFirst         ' auf dem ersten Datensatz aufsetzen
    Else
      MsgBox "es konnte nichts selektiert werden => Abbruch.", _
         16, "    fehlerhafte Selektion ?"
      Exit Sub
   End If

   Zeile_Z = 2

   Do While RecSet.EOF = False
      Zeile_Q = Zeile_Q + 1
      For Spalte = 0 To RecSet.Fields.Count - 1
         If IsNull(RecSet.Fields.Item(Spalte).Value) = False Then
            Select Case Spalte
               Case 0
                  If Zeile_Q = 2 Then
                     Anschluss = Trim(RecSet.Fields.Item(0).Value)
                   Else
                     If Anschluss <> Trim(RecSet.Fields.Item(0).Value) Then
                        Ziel.Cells(Zeile_Z, Spalte + 1) = Anschluss
                        Ziel.Cells(Zeile_Z, Spalte + 2) = Minuten
                        Anschluss = Trim(RecSet.Fields.Item(0).Value)
                        Minuten = 0
                        Zeile_Z = Zeile_Z + 1
                     End If
                  End If
               Case 1
                  Minuten = Minuten + RecSet.Fields.Item(1).Value
            End Select
         End If
      Next Spalte
      RecSet.MoveNext
   Loop

   Ziel.Cells(Zeile_Z, 1) = Anschluss
   Ziel.Cells(Zeile_Z, 2) = Minuten

   Cells.EntireColumn.AutoFit

   [A1].Select

   Application.ScreenUpdating = True

   RecSet.Close
   Connect.Close

Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.

Beliebteste Forumthreads (12 Monate)

Summe auslesen aus Access-Datenbank

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

326 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Summe auslesen aus Access-Datenbank

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

326 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread