Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
404to408
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
404to408
404to408
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

große Datenbank durchsuchen

große Datenbank durchsuchen
Michael
Hallo,
hab da eine größere Datenbank zu durchsuchen.
Meine Datenbank besteht aus 120 Spalten und 100 Zeilen.
In dieser Datenbank sind an umbestimmten Stellen Werte eingetragen.
Ich möchte nun die Werte addieren vor denen drei Spalten zuvor zb. 13 in der Datenbank vorkommt,
- a b c d e f g h i
1.......13..........13....
2......13.....4...........
3.........................
4..........13.............
5....13...................
6................13.....2.
Hier soll also 4 (in f2,daher in c2 steht "13") und 2 (in i6,daher in f6 steht "13") addiert werden.
Danke
Michael

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
nur mit vba
30.03.2004 04:52:52
mischa
ja das geht, aber nur mit vba.
Musst alle zellen feststellen, in denen dein Suchwert(13) vorkommt und dir mit VBA Zeile und Spalte merken. Dann brauchste ja nur noch alle gleichen Zeilen bzw. Spalte+3 die werte suchen und addieren. programmieraufwand ca. 45 minuten bei level vba gut schätz ich mal.
versuchs mal mit folgendem beispiel rauszubekommen:
https://www.herber.de/bbs/user/4774.zip
mischa
AW: große Datenbank durchsuchen
Holger
Hallo Michael,
es geht auch mit einer Formel, z.B.:
{=SUMME(WENN(A1:DP100=13;INDIREKT(ADRESSE(ZEILE(A1:DP100);SPALTE(A1:DP100)+3));0))}
{ } nicht eingeben, Formel eingeben und mit Strg+Umsch+Enter abschließen.
mfg Holger
Anzeige
AW: große Datenbank durchsuchen
Michael
Dank an Holger, aber klappt nicht ganz.:-(
AW: große Datenbank durchsuchen
Holger
merkwürdig, bei mir klappt es.
Holger
versionen 8,9, und 10
mischa
du hast ja auch xl 10.0
claudia nur xl 8.0
und ich 9.0
mischarichter
www.miaj.de
=SUMMENPRODUKT((A1:CV100=13)*D1:CY100)
Boris
Grüße Boris
AW: =SUMMENPRODUKT((A1:CV100=13)*D1:CY100)
Michael
Danke Boris, klappt wunderbar.
Michael
Code anzeigen
claudia
Hallo Mischa,
ich stehe vor einem ähnlichen Problem wie Michael. Deshalb möchte ich mir gerne den Code zu Deinem Bsp. ansehen. Leider ist es mit ALT F11 nicht möglich. Kannst Du mir sagen wie?
Gruß
Claudia
für claudia
30.03.2004 20:16:43
mischa
claudia,
mit deiner excel-version kannste meinen code mit alt+f11 nich anzeigen - hier isser als text:
Option Explicit
Option Base 0
Private Const MaxSuchZeilen = 21 'So viele Zeilen werden maximal durchsucht
Private Const MaxSuchSpalten = 40 'so viele spalten werden durchsucht
Private Const SuchwertA = 0 'Nach diesem Wert wird standardmäßig gesucht
Private Suchwert As Variant
Private Type GefundeneZellenA
ObenLinksTOP As Long
ObenLinksLEFT As Long
End Type
Private GefundeneZellen() As GefundeneZellenA
Sub ZellenMitWertenFinden()
Suchwert = InputBox("Nach welchem Wert soll gesucht werden?", "Suchwertabfrage", SuchwertA)
If Suchwert = "" Then Exit Sub

'Suchwerte in der Tabelle reinschreiben:
Cells(MaxSuchZeilen + 1, 1).Value = "Gesucht wird nach: " & Suchwert
Cells(MaxSuchZeilen + 2, 1).Value = "Durchsuchte Zeilen: 0 bis " & MaxSuchZeilen
Cells(MaxSuchZeilen + 3, 1).Value = "Durchsuchte Spalten: 0 bis " & MaxSuchSpalten


Dim ZelleA As Object
ReDim GefundeneZellen(0)

Application.ScreenUpdating = False

For Each ZelleA In ActiveSheet.Cells
If ZelleA.Row >= MaxSuchZeilen Then Exit For
If ZelleA.Column Application.StatusBar = "Zeile: " & ZelleA.Row & " - Spalte: " & ZelleA.Column

If ZelleA.Text = Suchwert And ZelleA.Value "" Then
ZelleA.Interior.ColorIndex = 3
GefundeneZellenSpeichern (ZelleA.Top + ZelleA.Height / 2), (ZelleA.Left + ZelleA.Width / 2)
ZelleA.Font.Bold = True
Else
ZelleA.Interior.ColorIndex = 22
ZelleA.Font.Bold = False
End If
End If
Next

'Dim RetVal As Long
'RetVal = MsgBox("Linien ziehen", vbYesNo)
'If RetVal = vbYes Then Call LinienZiehen
LinienZiehen
Beep
End Sub

Private Sub GefundeneZellenSpeichern(OLiT As Long, OLiL As Long)
ReDim Preserve GefundeneZellen(UBound(GefundeneZellen()) + 1)
GefundeneZellen(UBound(GefundeneZellen())).ObenLinksLEFT = OLiL
GefundeneZellen(UBound(GefundeneZellen())).ObenLinksTOP = OLiT
'Debug.Print Time & ": Eintrag Nr.: " & UBound(GefundeneZellen()) & _
"= LeftWert: " & GefundeneZellen(UBound(GefundeneZellen())).ObenLinksLEFT & _
"; TOP_Wert: " & GefundeneZellen(UBound(GefundeneZellen())).ObenLinksTOP
End Sub


Private Sub LinienZiehen()
'alte Linien löschen:
Dim LInieA As Shape
For Each LInieA In ActiveSheet.Shapes
If LInieA.Top <> 0 And LInieA.Left <> 0 Then
'der links oben und links außen befindliche Button soll mal nicht gelöscht werden!
LInieA.Delete
End If
Next
'Linienziehen
Dim MaxGefundeneZellen As Long
MaxGefundeneZellen = UBound(GefundeneZellen())
If MaxGefundeneZellen < 2 Then
MsgBox "Es wurde keine oder nur eine Zelle gefunden, deshalb werden keine Linien eingefügt!", vbExclamation
Exit Sub
End If
Dim StartOLiT As Long, StartOLiL As Long, EndeOLiT As Long, EndeOLiL As Long
Dim Linienzähler As Long
Dim ZÄhler1 As Long, Zähler2 As Long
For ZÄhler1 = 1 To MaxGefundeneZellen - 1
For Zähler2 = ZÄhler1 + 1 To MaxGefundeneZellen
StartOLiT = GefundeneZellen(ZÄhler1).ObenLinksTOP
StartOLiL = GefundeneZellen(ZÄhler1).ObenLinksLEFT
EndeOLiT = GefundeneZellen(Zähler2).ObenLinksTOP
EndeOLiL = GefundeneZellen(Zähler2).ObenLinksLEFT
With ActiveSheet.Shapes.AddLine(StartOLiL, StartOLiT, EndeOLiL, EndeOLiT).Line
'.DashStyle = msoLineThickBetweenThin
.ForeColor.RGB = RGB(100, 50, 128)
.Weight = 1.5
End With
Linienzähler = Linienzähler + 1
Next Zähler2
Next ZÄhler1
Application.StatusBar = "Insgesamt eingefügte Linien: " & Linienzähler
Range("a1").Activate
End Sub

'MischaRichter
'www.miaj.de
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige