Thema Datum  Von Nutzer Rating
Antwort
27.10.2022 12:30:11 Stephan
NotSolved
27.10.2022 13:49:16 Mase
NotSolved
27.10.2022 14:31:57 Gast86887
NotSolved
24.11.2022 12:14:30 Stephan
NotSolved
24.11.2022 17:48:44 Gast48682
NotSolved
25.11.2022 12:03:22 Gast79966
NotSolved
28.11.2022 12:59:49 Stephan
NotSolved
28.11.2022 13:21:04 Mase
NotSolved
28.11.2022 13:40:06 Gast66289
NotSolved
28.11.2022 14:32:00 Mase
NotSolved
28.11.2022 14:55:44 Stephan
NotSolved
Blau VBA: Werte dynamisch summieren
25.11.2022 12:08:41 Stephan
NotSolved

Ansicht des Beitrags:
Von:
Stephan
Datum:
25.11.2022 12:08:41
Views:
412
Rating: Antwort:
  Ja
Thema:
VBA: Werte dynamisch summieren

So sieht mein Code aktuell aus:

Public Sub transfer()

   Dim i   As Long
   Dim rs  As Object
   Dim Blatt As Worksheet
   Dim rngZelle As Range, rngSrc As Range
    
    For Each Blatt In ActiveWorkbook.Worksheets
      Blatt.Unprotect ("xxx")
    Next Blatt

If MsgBox("Willst du die Berechnung starten? JA/NEIN", vbYesNo) = vbYes Then

Set rs = CreateObject("ADODB.Recordset")
     
    
rs.Open ActiveConnection:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml""", _
        Source:="SELECT [Material] , sum([Book quantity]) As Korrektur, sum([Difference Quantity]) As Differenz, sum([Difference Quantity1]) As Betrag " & _
                "FROM (SELECT * FROM `Daten$` WHERE [Difference Quantity1] >= 1000) " & _
                "Group By [Material]"
                      
        
    Worksheets("Ergebnis").Range("A3:D2000").Cells.ClearContents
   
        
    Set rngSrc = Range("F3:F2000")
    If Not rngSrc.MergeCells Then
        rngSrc.ClearContents
    Else
        For Each rngZelle In rngSrc
            rngZelle.MergeArea.ClearContents
        Next
    End If
    
    Worksheets("Ergebnis").Range("A2").CopyFromRecordset rs
     
     
 
    Do
        Worksheets("Ergebnis").Cells(2, i + 1).Value = rs.Fields(i).Name
        i = i + 1
    Loop While i < rs.Fields.Count
     
     
    rs.Close
    
    Worksheets("Ergebnis").Activate
     
MsgBox "Übertragung erfolgreich !!!"


Else

MsgBox "Vorgang abgebrochen"
Worksheets("Daten").Activate

End If

    For Each Blatt In ActiveWorkbook.Worksheets
      Blatt.Protect ("xxx")
    Next Blatt

Application.ScreenUpdating = True

End Sub


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
27.10.2022 12:30:11 Stephan
NotSolved
27.10.2022 13:49:16 Mase
NotSolved
27.10.2022 14:31:57 Gast86887
NotSolved
24.11.2022 12:14:30 Stephan
NotSolved
24.11.2022 17:48:44 Gast48682
NotSolved
25.11.2022 12:03:22 Gast79966
NotSolved
28.11.2022 12:59:49 Stephan
NotSolved
28.11.2022 13:21:04 Mase
NotSolved
28.11.2022 13:40:06 Gast66289
NotSolved
28.11.2022 14:32:00 Mase
NotSolved
28.11.2022 14:55:44 Stephan
NotSolved
Blau VBA: Werte dynamisch summieren
25.11.2022 12:08:41 Stephan
NotSolved