Daten in Excel suchen und addieren

Schrumpel

Schrumpel

Mitglied
"FERTIG" Daten in Excel suchen und addieren

Ich hab hier eine excel mappe mit mehren tabellen. nun muss ich aus allen seiten die stunden für bestimmte arbeitsaufgaben heraussuchen und addieren und auf der ersten seite eintragen.
es steht jeweils im feld B die Tätigkeit als Zahl(selbe tätigkeit selbe zahl) und im D feld dann die anzahl der stunden. dies soll über alle tabellen der mappe gehen.
Wie mach ich sowas? bin leider blutiger anfänger in VB.
 
Zuletzt bearbeitet:
Ich weiß nicht, was du erwartest.
Ersteinmal solltest du dich in die ganze Geschichte ein wenig reinarbeiten. Konkrtete Fragen kann man ja beantworten, aber doch nicht sowas. Willst du dass dir wer den kompletten Code postet?

Bei dieser ganzen VBA-Geschichte kann man sich aber relativ leicht selbst helfen. Da gibt es z.B. die Möglichkeit ein Makro aufzuzeichnen. Du zeichnest bestimmte Aktionen auf und schaust dir dann den Code dieses Makros an.
Dort schaust du dir die Befehle an, die du benötigst. So z.B. Zelleninhalt auslesen + kopieren, andere Tabellen aktivieren etc.

Das dürfte dann eigentlich kein Problem sein! Falls du dann aber noch Fragen hast, werden dir diese bestimmt gerne beantwortet.

Viel Spaß!
 
Ich erwarte nur Hilfe.

Ich will ja gar nicht das ihr mir den fertigen Quellcode hier posted. Ist wohl falsch rüber gekommen.
ich brauchte mehr nen Schibs für den Anfang.
ich bin jetzt soweit das ich in einem Blatt schon mal suche und auch das finde was ich will.
wie kann ich die Suche auf alle Blätter erweitern?
Wie speicher ich die Werte um sie zu addieren und in ein feld zu schreiben?
Momentan markier ich mir die treffer mit Grau.
Code: 
Sub Suche()
Dim gefunden
Set gefunden = Cells.Find("202", LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not gefunden Is Nothing Then
  'MsgBox "Wert in " & gefunden.Row & " ist " & gefunden.Offset(0, 1)
  firstAddress = gefunden.Address
  Do
  gefunden.Interior.Pattern = xlPatternGray50
  Set gefunden = Cells.FindNext(gefunden)
  Loop While Not gefunden Is Nothing And gefunden.Address <> firstAddress
End If
End Sub

Ich will ja nicht als undankbarer Code schnorrer dastehen.
 
Wie kannst Du die Suche auf alle Blätter ausweiten.

Z.B. Indem Du nach abgeschlossener Suche auf der ersten Seite auf die nächste Seite wechselst?

kann als Makro aufgezeichnet werden, dann hast Du den Code, und kopierst Ihn in Dein Original, und beginnst Deinen jetztigen Code von neuem, dann noch ne Abfrage in diese Schleife rein, wenn kein Blatt mehr zum auswählen, dann fertig.

Oder zumindest so was in der Art.
 
Bin schon wieder ein stück weiter
Jetzt läuft die Suche über alle Blätter der Arbeitsmappe....

Code: 
Sub Suchen()
Dim gefunden
Dim firstAddress
Dim Address
Dim wks As Worksheet

For Each wks In Worksheets
MsgBox "Sheet Name " & wks.Name
Set gefunden = Worksheets(wks.Name).Cells.Find("203", LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not gefunden Is Nothing Then
    firstAddress = gefunden.Address
    Do
  gefunden.Interior.Pattern = xlPatternGray50
  Set gefunden = Worksheets(wks.Name).Cells.FindNext(gefunden)
    Loop While Not gefunden Is Nothing And gefunden.Address <> firstAddress
  
End If
Next wks
End Sub

kann mir jemand sagen wie ich beim find Befehl nur in einer bestimmten Spalte suchen kann und nur in der?
 
Pivot-tabelle

hallo,
also meiner meinung nach ist das problem am einfachsten, schnellsten mit einer pivot-tabelle zu lösen.

sollte das ganze dennoch in vba gelöst werden, ist es denke ich sinnvoll die such zu beschränken:
Code: 
With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Interior.Pattern = xlPatternGray50
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

der bereich wird hier also mit
Code: 
worksheets(1).range("a1:a500").find
auf die spalte A zeilen 1-500 eingeschränkt (ganze spalte .rang("A:A"))


gruß thekorn
 
Zuletzt bearbeitet:
pivot-tabelle

habe mal ein einfaches beispiel (pivot tabelle) erstellt

vorteile gegenüber VBA
-einfach
-permanente datenaktualisierung

gruß
thekorn
 

Anhänge

Habs mit dem Range probiert aber er findet immer noch werte die nicht im range bereich liegen.

Code: 
Sub Suche()
Dim lfdnr As Integer
Dim a As Integer
Dim ge2 As Single
Dim Gesamt As Single
Dim wks As Worksheet
Dim Sheet As String


For a = 2 To 250
Gesamt = "0"
For Each wks In Worksheets
If wks.Name = "ToDo" Then          'außer dem Blatt ToDo'
            lfdnr = Worksheets(wks.Name).Range("a1:a250")(a, 1)
            Else
            Set gefunden = Worksheets(wks.Name).Range("b1:b20").Find(lfdnr, LookIn:=xlValues)
        If Not gefunden Is Nothing Then
            firstAddress = gefunden.Address
            Do
            Set gefunden = Worksheets(wks.Name).Cells.FindNext(gefunden)
             ge2 = gefunden.Offset(0, 2)
            Gesamt = Gesamt + ge2
             Loop While Not gefunden Is Nothing And gefunden.Address <> firstAddress
            Worksheets("ToDo").Cells(a, 8).Value = Gesamt
   
End If
End If
Next wks
Next a
End Sub

Ist da noch irgendwo ein Fehler?
 
FERTIG

So habs fertig.
falls es jemanden interessiert.

Zur Erklärung:
Ich habe eine Excelmappe mit zur zeit 27 Blättern. Auf dem ersten Blatt "ToDo" stehen in der ersten spalte Auftragsnummern. die lese ich automatisch aus und durchsuche daraufhin alle anderen blätter danach. dabei schreibe ich die gesamstunden der einzelnen aufträge auf das "ToDo" Blatt hinter die auftragsnummer.
Ok man hätte jetzt auch ne Pivottabelle machen können aber so sieht man nichts davon, ich kann neue Blätter einfügen ohne das ich irgendetwas verändern muss.

Code: 
Sub Suche()
Dim gefunden
Dim firstAddress
Dim a As Integer
Dim l As Integer
Dim lfdnr As String
Dim ge2 As Single
Dim Gesamt As Single
Dim wks As Worksheet
Dim letzterWert As Long


letzterWert = Cells(Rows.Count, 1).End(xlUp).Row        'Berechen der letzten Zeile mit Inhalt in "ToDo"

For a = 2 To letzterWert                              'Definieren des Zeilenbereichs für den Suchbegriff in "ToDo"
Gesamt = "0"                                            'Rücksetzten von Gesamt auf 0
    For Each wks In Worksheets                          'Schleife zum durchlaufen aller Blätter
        If wks.Name = "ToDo" Then                       'aus dem Blatt "ToDo" den Wert zum suchen herausholen
            lfdnr = Worksheets(wks.Name).Cells.Range("A:A")(a, 1)       'Suchbreich für den Suchwert im "ToDo" Blatt
            l = Len(lfdnr)                              'Länge des Suchwertes berechnen
        Else
                Set gefunden = Worksheets(wks.Name).Range("B1:B30").Cells.Find(lfdnr, LookIn:=xlValues)     'Suchfunktion mit Bereich
                If Not gefunden Is Nothing Then
                    firstAddress = gefunden.Address     'Speichern der ersten Adresse des gefundenden Wertes auf einen Blatt
                    Do
                        Set gefunden = Worksheets(wks.Name).Cells.Range("B1:B30").FindNext(gefunden)        'Übergabe Suchwert an FindNext
                        ge2 = gefunden.Offset(0, 2)     'Stundenanzahl des gefunden Wertes speichern
                        t = Len(gefunden)               'Länge des gefundenen Wert berechnen und speichern
                            If l = t Then               'Wenn die Länge der Werte gleich sind werden sie addiert
                                Gesamt = Gesamt + ge2
                            Else
                                ge2 = "0"
                            End If
                    Loop While Not gefunden Is Nothing And gefunden.Address <> firstAddress     'Schleife bis Anfangsadresse erreicht ist(Blatt durchsucht)
                        Worksheets("ToDo").Cells(a, 10).Value = Gesamt                           'Schreiben des Wertes in das "ToDo" Blatt
                End If
        End If
    Next wks
Next a

End Sub

Danke für die Hilfe
 
Zuletzt bearbeitet:
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück