Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 08:01:34
Textbox Inhalt prüfen und Code abbrechen
24.04.2024 06:38:45
Kumulierte Daten für Intervalllaufeinheiten
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
712to716
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
712to716
712to716
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Summen per Makro

Summen per Makro
22.12.2005 15:40:10
Daniel
Hallo!
Ich habe zwei Blätter, Bericht_Daten und Auswertung.
Wie der Blattname schon sagt, stehen in dem ersten Ballt jede Menge Zahlen.
Aus diesen möchte ich nun eine Zusammenfassung machen, um diese später in einem Bericht ausweisen zu können.
In den Zellen der Spalte C steht Text und in den Zellen der Spalte F stehen Zahlen.
Nun möchte ich die Zahlen der Spalte F von den Zeilen addieren, bei denen der gleiche Text steht. Kommt der Text nur einmal vor, so soll einfach diese Zahl genommen werden.
Die Ergebnisse sollen ins Blatt Auswertung. Die Texte in Spalte A und die dazugehörigen Ergebnisse in Spalte B. Die Reihenfolge ist dabei egal.
Ich hoffe ich ihr versteht mein Vorhaben. Wie muss so ein Makro aussehen?
Danke für eure Hilfe!
Daniel

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Summen per Makro
22.12.2005 16:52:36
Fredericke
Versuche es über eine Summe wenn!!!!
1. Bereich definieren
Dim textbereich1 as Range
Dim zahlenbereich as Range
textbereich = Range(Cells(14, 7), Cells(100, 7)) Textspalte
textbereich = Range(Cells(14, 8), Cells(100, 8)) Textspalte
betrag = Application.WorksheetFunction.sumif(textbereich, Zieltext, zahlenbereich)
Hoffe es klappt!!
Fredericke
AW: Summen per Makro
22.12.2005 16:56:01
Hampi
Hall Daniel
Vielleicht wirst du mit der Funktion Konsolidieren (auch übers Menü erreichbar) glücklich.
Annahmen: Name des Files 'Datei.xls', Spalten c bis f markiert und mit dem Namen 'Bereich' versehen. Makro im vorher leeren Zielblatt ausführen.

Sub Konsolidieren()
Cells.Select
Selection.Consolidate Sources:="Datei!bereich", Function:=xlSum, TopRow _
:=False, LeftColumn:=True, CreateLinks:=True
End Sub

Das Makro einbinden mit alt+F11 Einfügen-Modul, obigen Code mit copy+paste hineinkopieren - ok. Im Excelzielblatt z.B. mit alt+F8 anwählen und ausführen.
Gruss
Hampi
Anzeige
AW: Summen per Makro
22.12.2005 17:08:22
Josef
Hallo Daniel!
Probier mal!
' **********************************************************************
' Modul: mdlMain Typ: Allgemeines Modul
' **********************************************************************

Option Explicit


Sub DatenHolen()
Dim objSH1 As Worksheet, objSH2 As Worksheet
Dim lngLastRow As Long, lngRow As Long, lngIndex As Long, lngMatch As Variant
Dim varArray1 As Variant, varArray2() As Variant, varArray3() As Variant

Set objSH1 = Sheets("Bericht_Daten")
Set objSH2 = Sheets("Auswertung")

lngLastRow = objSH1.Range("C65536").End(xlUp).Row
varArray1 = objSH1.Range("C2:F" & lngLastRow)

Redim Preserve varArray2(lngIndex)
Redim Preserve varArray3(lngIndex)

For lngRow = 1 To UBound(varArray1, 1)
  If lngRow = 1 Then
    varArray2(lngIndex) = varArray1(lngRow, 1)
    varArray3(lngIndex) = varArray1(lngRow, 4)
  Else
    lngMatch = Application.Match(varArray1(lngRow, 1), varArray2, 0)
    If Not IsNumeric(lngMatch) Then
      lngIndex = lngIndex + 1
      Redim Preserve varArray2(lngIndex)
      Redim Preserve varArray3(lngIndex)
      varArray2(lngIndex) = varArray1(lngRow, 1)
      varArray3(lngIndex) = varArray1(lngRow, 4)
    Else
      varArray3(lngMatch - 1) = varArray3(lngMatch - 1) + varArray1(lngRow, 4)
    End If
  End If
Next

objSH2.Range("A2:A" & UBound(varArray2) + 2) = Application.Transpose(varArray2)
objSH2.Range("B2:B" & UBound(varArray2) + 2) = Application.Transpose(varArray3)

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
Ok, noch eine Bitte dazu!
22.12.2005 17:15:41
Daniel
Hallo Josef,
danke für die Hilfe!
Kann man das Ganze auch erst aber einer bestimmten Zeile fürs Blatt Bericht_Daten laufen lassen? Da zuvor Überschriften usw. stehen die das etwas unschön machen.
Grüße,
Daniel
AW: Ok, noch eine Bitte dazu!
22.12.2005 17:37:25
Josef
Hallo Daniel!
kein Problem!
Sub DatenHolen()
Dim objSH1 As Worksheet, objSH2 As Worksheet
Dim lngLastRow As Long, lngFirstRow As Long, lngRow As Long, lngIndex As Long, lngMatch As Variant
Dim varArray1 As Variant, varArray2() As Variant, varArray3() As Variant

Set objSH1 = Sheets("Bericht_Daten")
Set objSH2 = Sheets("Auswertung")

lngFirstRow = 5 '--> Startzeile --> anpassen

lngLastRow = objSH1.Range("C65536").End(xlUp).Row
varArray1 = objSH1.Range(objSH1.Cells(lngFirstRow, 3), objSH1.Cells(lngLastRow, 6))

Redim Preserve varArray2(lngIndex)
Redim Preserve varArray3(lngIndex)

For lngRow = 1 To UBound(varArray1, 1)
  If lngRow = 1 Then
    varArray2(lngIndex) = varArray1(lngRow, 1)
    varArray3(lngIndex) = varArray1(lngRow, 4)
  Else
    lngMatch = Application.Match(varArray1(lngRow, 1), varArray2, 0)
    If Not IsNumeric(lngMatch) Then
      lngIndex = lngIndex + 1
      Redim Preserve varArray2(lngIndex)
      Redim Preserve varArray3(lngIndex)
      varArray2(lngIndex) = varArray1(lngRow, 1)
      varArray3(lngIndex) = varArray1(lngRow, 4)
    Else
      varArray3(lngMatch - 1) = varArray3(lngMatch - 1) + varArray1(lngRow, 4)
    End If
  End If
Next

'Ausgabe ab Zeile zwei!
objSH2.Range("A2:A" & UBound(varArray2) + 2) = Application.Transpose(varArray2)
objSH2.Range("B2:B" & UBound(varArray2) + 2) = Application.Transpose(varArray3)

''Soll die Ausgabe zB. erst ab Zeile fünf erfolgen, dann
'objSH2.Range("A5:A" & UBound(varArray2) + 5) = Application.Transpose(varArray2)
'objSH2.Range("B5:B" & UBound(varArray2) + 5) = Application.Transpose(varArray3)

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
Danke für die super Hilfe!
23.12.2005 08:51:58
Daniel
...

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige