Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Werte mit gleicher Auftragsnummer addieren

Frage Entwicklung VB for Applications

Mitglied: Semih55

Semih55 (Level 1) - Jetzt verbinden

10.09.2014, aktualisiert 16:37 Uhr, 1060 Aufrufe, 8 Kommentare, 1 Danke

Hallo Zusammen,

ich habe ein Excel-sheet mit Auftragsnummer, Kunde und Betrag.

Jetzt möchte ich alle Beträge mit gleicher Auftragsnummer addiert haben.

Problem: - Die Beträge sind nicht als eine Zahl definiert, - Im Betrag stehen Tausender mit einem Punkt (z.B. 3.550,50),

Ich habe schon eine Funktion mit der ich den "Punkt" aus dem Betrag entfernen kann:

01.
Public Sub Zeichenloeschung() 
02.
Dim i As Long 
03.
Dim Start As String 
04.
Dim Ende As String 
05.
Dim Temp As String 
06.
Dim erlaubt As String 
07.
 
08.
erlaubt = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890,<> " ' <- hier werden die Zeichen definiert, die erlaubt sind; 
09.
' Groß-/Kleinschreibung wird ignoriert 
10.
Application.ScreenUpdating = False ' Bildschirm-Aktualisierung wird hier deaktiviert; 
11.
' Ansonsten dauert der Vorgang noch ein wenig länger, da er sonst jede Änderung sofort anzeigt 
12.
    For Each C In Selection 
13.
        With C 
14.
            Temp = "" 
15.
            For i = 1 To Len(.Text) 
16.
                If InStr(1, erlaubt, Mid(.Text, i, 1), vbTextCompare) > 0 Then 
17.
                    Temp = Temp & Mid(.Text, i, 1) 
18.
                End If 
19.
            Next i 
20.
            .Value = Temp 
21.
        End With 
22.
        Next C 
23.
Application.ScreenUpdating = True ' Jetzt wird die Anzeige wieder aktualisiert 
24.
 
25.
End Sub 
26.
 
Nun brauche ich noch eine Funktion mit der ich die Beträge addieren kann.
Auch hier habe ich eine Funktion mit der ich experimentierte

01.
Sub Semih_Formel_fuer_Martina() 
02.
QTabelle = "Summary"                                               'Quelltabelle 
03.
QAbZeile = 1                                                             'Überschriftenzeile in Quelltabelle 
04.
QAbSpalte = 2                                                          'Nummer der 1. Datenspalte in Quelltabelle 
05.
QBSpalte = "L"                                                        'Spalte für Betrag in Quelltabelle 
06.
 
07.
Spalten = 2                                                                'Spaltenanzahl für Vergleich 
08.
 
09.
ZTabelle = "Details"                                                       'Zieltabelle 
10.
ZAbZeile = 1                                                               'Überschriftenzeile in Zieltabelle 
11.
ZAbSpalte = 1                                                             'Nummer der 1. Datenspalte in Zieltabelle 
12.
ZBSpalte = "D"                                                             'Spalte für Betag in Zieltabelle 
13.
 
14.
Delim = "§"                                                                   'Trennzeichen - darf in den Daten nicht vorkommen 
15.
 
16.
Set d = CreateObject("Scripting.Dictionary")                      'Dictionary zum Zwischenspeichern der (konsolidierten) Zeile erzeugen 
17.
QZeile = QAbZeile                                                             'in Überschriftenzeile der Quelltabelle starten 
18.
With Worksheets(QTabelle) 
19.
    Do Until .Cells(QZeile, QAbSpalte) = ""                            'Zeilen bearbeiten, bis in erster Spalte kein Wert mehr vorhanden 
20.
        K = ""                                                                        'Schlüssel initialisieren 
21.
        For i = 0 To Spalten - 1                                                 'alle Schlüsselspalten durchgehen 
22.
            K = K & Delim & .Cells(QZeile, QAbSpalte + i)             'Schlüssel zusammensetzen 
23.
        Next 
24.
        K = Mid(K, 2)                                                                'erstes Zeichen ist ein Trennzeichen - weglassen 
25.
        Betrag = Val(.Cells(QZeile, QBSpalte))                           'Betrag auslesen 
26.
        If d.Exists(K) Then                                                         'Wenn schon ein Eintrag für diesen Schlüssel vorhanden, ... 
27.
            d.Item(K) = d.Item(K) + Betrag                                      '... Betrag addieren, ... 
28.
        Else 
29.
            d.Add K, Betrag                                                            '... ansonsten Eintrag erstellen 
30.
        End If 
31.
        QZeile = QZeile + 1                                                           'nächste Zeile der Quelltabelle 
32.
    Loop 
33.
End With 
34.
 
35.
T = d.Keys                                                                               'Schlüssel-Texte in Array übernehmen 
36.
B = d.Items                                                                             'Beträge detto 
37.
With Worksheets(ZTabelle) 
38.
    .Cells.ClearContents                                                             'Zieltabelle löschen 
39.
    ZZeile = ZAbZeile                                                                   'in Überschriftenzeile der Zieltabelle beginnen 
40.
    For i = 0 To UBound(T)                                                            'alle konsolidierten Einträge durchgehen 
41.
                                                                                                 'Schlüssel-Text wieder in Spalten zerlegen und eintragen 
42.
        .Cells(ZZeile, ZAbSpalte).Resize(1, Spalten) = Split(T(i), Delim) 
43.
        .Cells(ZZeile, ZBSpalte) = B(i)                                                 'Betrag(ssumme) eintragen 
44.
        ZZeile = ZZeile + 1                                                                  'nächste Zeile der Zieltabelle 
45.
    Next 
46.
End With 
47.
End Sub 
48.
 
49.
 
Die Funktion addiert den Betrag mit gleicher Auftragsnummer der Tabelle1 und fügt quasi einen neuen sheet hinzu mit den bearbeiteten Daten.
Allerdings addiert diese Funktion nur ganze Zahlen (also keine Kommastellen). Dazu müsste ich die Zahl in Double umwandeln aber bekomme ich leider nicht hin.


Ich wäre sehr dankbar, wenn mir jemand helfen könnte.
Mitglied: colinardo
10.09.2014, aktualisiert um 16:12 Uhr
Hallo semih55, Willkommen auf Administrator.de!
Warum so viel Aufwand wenn's doch so einfach mit einer Formel geht :
SUMMEWENN(Bereich;Suchkriterien;[Summe_Bereich])
SummeWenn

Lässt sich aber auch in VBA verwenden:
Application.WorksheetFunction.SumIf(Arg1, Arg2, Arg3)
Arg1 Erforderlich Range Bereich – der Zellbereich, der nach Kriterien ausgewertet werden soll.  
Arg2 Erforderlich Variant Kriterien – die Kriterien in Form einer Zahl, eines Ausdrucks oder Texts, mit dem definiert wird, welche Zellen addiert werden. Kriterien können beispielsweise als 32, "32", ">32", oder "Äpfel" angegeben werden.  
Arg3 Optional Variant Summe_Bereich – die tatsächlich zu addierenden Zellen, wenn die entsprechenden Zellen in Bereich auf Kriterien zutreffen. Wenn Summe_Bereich ausgelassen wird, werden die Zellen im Bereich sowohl nach Kriterien ausgewertet als auch addiert, sofern sie Kriterien entsprechen. 
Grüße Uwe
Bitte warten ..
Mitglied: Semih55
10.09.2014 um 16:13 Uhr
Ich wollte eine Funktion mit der ich durch einen Klick das Ergebnis habe (über Symbole-Schnellzugriff --> Makro hinzufügen).

Über eine Formel habe ich das auch zum laufen gebracht: =WENN(ZÄHLENWENN($B$2:B29;B29)>1;"";SUMMENPRODUKT(($B$2:$B$427=B29)*($L$2:$L$427)))

Allerdings weiß ich nicht wie ich das automatisieren kann.

Also dass man nicht immer die Formel kopieren muss und "runter ziehen" damit es für alle Zellen macht.
Bitte warten ..
Mitglied: LianenSchwinger
10.09.2014 um 16:17 Uhr
Hallo semih55,

und wenn Dein Betrag als Zeichenkette eingetragen ist kann man diesen einfach mit z.B. =WERT(A1) in eine Zahl umwandeln.

G Jörg
Bitte warten ..
Mitglied: colinardo
LÖSUNG 10.09.2014, aktualisiert um 16:37 Uhr
Und wenn es unbedingt ein Makro sein muss, habe ich hier schon mal ein Makro zum selben Thema gespostet:
Werte aus einer Tabelle vergleichen, einlesen und addieren
und für die Umwandlung in eine Zahl kannst du bspw. CDbl("1.200,30") nutzen.
Bitte warten ..
Mitglied: Semih55
10.09.2014 um 16:34 Uhr
Vielen Dank schonmal für deine Hilfe.
Ich habe deinen Makro getestet. Die funktioniert im Prinzip genauso wie meine allerdings mit dem selben "Fehler".
Wenn ich Komma-zahlen addiere dann rechnet deine Funktion ohne die Nachkommastellen.

Wie müsste ich deine Funktion umschreiben damit er auch die Nachkommastellen rechnet??
Bitte warten ..
Mitglied: colinardo
10.09.2014, aktualisiert um 16:40 Uhr
einfach wie geschrieben in Double umwandeln:
in meinem Sheet folgende Zeile so umgeschrieben
cell.Offset(0, 3).Value = CDbl(cell.Offset(0, 3).Value) + CDbl(c.Offset(0, 6).Value)
Bitte warten ..
Mitglied: Semih55
10.09.2014, aktualisiert um 16:53 Uhr
01.
  
02.
Sub Semih_Formel_fuer_Martina() 
03.
QTabelle = "Summary"                                                                                 
04.
QAbZeile = 1                                                                                         
05.
QAbSpalte = 2                                                                                        
06.
QBSpalte = "L"                                                                                      
07.
 
08.
Spalten = 2                                                                                          
09.
 
10.
ZTabelle = "Details"                                                                               
11.
ZAbZeile = 1                                                                                         
12.
ZAbSpalte = 1                                                                                       
13.
ZBSpalte = "D"                                                                                      
14.
 
15.
Delim = "§"                                                                                          
16.
 
17.
Set d = CreateObject("Scripting.Dictionary")                                                        
18.
QZeile = QAbZeile                                                                                    
19.
With Worksheets(QTabelle) 
20.
    Do Until .Cells(QZeile, QAbSpalte) = ""                                                         
21.
        K = ""                                                                                      
22.
        For i = 0 To Spalten - 1                                                                   
23.
            K = K & Delim & .Cells(QZeile, QAbSpalte + i)                                       
24.
        Next 
25.
        K = Mid(K, 2)                                                                               
26.
        Betrag = Val(.Cells(QZeile, QBSpalte))                                                     
27.
        If d.Exists(K) Then                                                                          
28.
            d.Item(K) = CDbl(d.Item(K)) + CDbl(Betrag)                                                
29.
        Else 
30.
            d.Add K, Betrag                                                                        
31.
        End If 
32.
        QZeile = QZeile + 1                                                                    
33.
    Loop 
34.
End With 
35.
 
36.
T = d.Keys                                                                                         
37.
B = d.Items                                                                                         
38.
With Worksheets(ZTabelle) 
39.
    .Cells.ClearContents                                                                            
40.
    ZZeile = ZAbZeile                                                                               
41.
    For i = 0 To UBound(T)                                                                         
42.
                                                                                                    
43.
        .Cells(ZZeile, ZAbSpalte).Resize(1, Spalten) = Split(T(i), Delim) 
44.
        .Cells(ZZeile, ZBSpalte) = B(i)                                                              
45.
        ZZeile = ZZeile + 1                                                                        
46.
    Next 
47.
End With 
48.
End Sub 
49.
 
50.
 
Ich bekomme es einfach nicht hin:/

Ich habe jetzt bei meiner Funktion versucht "CDbl" einzufügen: d.Item(K) = CDbl(d.Item(K)) + CDbl(Betrag)
Aber er rechnet trotzdem nicht die Nachkommastellen.

Könntest du mit bitte für meine konkrete Funktion weiterhelfen?
Bitte warten ..
Mitglied: colinardo
11.09.2014, aktualisiert um 11:16 Uhr
Könntest du mit bitte für meine konkrete Funktion weiterhelfen?
Ich arbeite schon lange mit Excel, aber so umständlich hab ich's schon lange nicht mehr erlebt aber egal jedem das seine.

Dieser Abschnitt sollte so aussehen: (dort hattest du die Funktion VAL() verwendet, die den Betrag immer in einen Integer-Wert ohne Nachkomma gewandelt hat!
01.
... 
02.
        Betrag = CDbl(.Cells(QZeile, QBSpalte).Value) 
03.
        If d.Exists(K) Then 
04.
            d.Item(K) = CDbl(d.Item(K)) + Betrag 
05.
        Else 
06.
....
Dann klappts auch mit den "Mäusen" nach dem Komma

Grüße Uwe

p.s. gewöhne dir mal an, die Variablen und deren Variablen-Typen (string/integer/double) vor der Verwendung entsprechend zu deklarieren, dann kommt es nicht zu solchen Effekten.
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
PHP
gelöst Werte in einer sql Spalte addieren (13)

Frage von helmuthelmut2000 zum Thema PHP ...

Firewall
gelöst Site-to-Site-VPN und Cisco VPN-Client von gleicher IP (2)

Frage von TripleDouble zum Thema Firewall ...

Netzwerke
LAN und WLAN je mit gleicher IP (13)

Frage von dauatitsbest zum Thema Netzwerke ...

Netzwerkmanagement
gelöst Icingaweb2 Werte für das NRPE CheckDisk anpassen (8)

Frage von M.Marz zum Thema Netzwerkmanagement ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Outlook & Mail
gelöst Outlook 2010 findet ost datei nicht (19)

Frage von Floh21 zum Thema Outlook & Mail ...

Netzwerkmanagement
gelöst Anregungen, kleiner Betrieb, IT-Umgebung (18)

Frage von Unwichtig zum Thema Netzwerkmanagement ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...