| |
Suche Visual-Basic CodeSuchen und Finden bis zu 4 Jahren | | | Autor: Coffee | Datum: 17.07.16 08:14 |
| Guten Morgen,
ich komme nicht weiter mit meinem Programm. Brauche HIlfe .
Spalte A ist Datum, Spalte B ist Kunde, Spalte D ist Kosten.In Spalte C sollen die Kosten summiert der gleichen Kunde wie im Vormonat kommen.
Im ersten Monat soll der erste Kunde im Monat zwei gesucht werden.
Wenn gefunden, sollen die Kosten addiert und in Spalte C vom 2. Monat angezeigt werden.
Dann soll der nächste Kunde gesucht werden.
Wenn Kunde im ersten Monat nicht im zweiten Monat vorhanden ist, dann soll im 3. Monat und im 4. Monat gesucht werden.
Das gleiche dann mit dem 2. Monat
Der Kunde im 2. Monat soll im 3. Monat gesucht wertden. Wenn nicht vorhanden, dann im 4.Monat, wenn nicht, dann im 5. Monat, wenn nicht, dann im 6. Monat.
Also die Suche soll in den nächsten 4 Monaten sein.
Mein Programm sucht den Kunden im 1. Monat in allen Monaten. Wie kann ich dies begrenzen.
Vielen Dank
LG
A B C D
2010 03
aa 5
bb 2
cc 3
2010 04
ss 2
aa 4
cc 5
2010 05
bb 1
aa 2
2010 06
kk 2
aa 4
2010 07 kk 3
bb 1 Sub Neu()
Dim intSuche As Integer
Dim rngcell As Range
Dim rngcell2 As Range
Dim c As Range
Dim CompareRange As Variant, a As Variant, b As Variant
With ActiveSheet
'zählt bis nächsten Datum
lrow = .Cells(.Rows.Count, 1).End(xlUp).Row
l = 2
Do While Cells(l, 1).Value <> ","
'Suchwert festlegen (anpassen!):
Suche = "*"
Set rngcell = .Columns(1).Cells.Find(Suche, .Cells(lrow, 1), , xlWhole, , _
xlNext)
If Not rngcell Is Nothing Then 'wenn etwas gefunden wurde
xZahl = rngcell
On Error Resume Next
End If
arrSplit1 = Split(xZahl, " ")
If UBound(arrSplit1) >= 1 Then
bereichLft = arrSplit1(0)
bereichRgt = arrSplit1(1)
x = bereichLft & bereichRgt
End If
Set rngcell2 = .Columns(1).Cells.FindNext(rngcell)
yZahl = rngcell2
arrSplit2 = Split(yZahl, " ")
If UBound(arrSplit2) >= 1 Then
bereichLft = arrSplit2(0)
bereichRgt = arrSplit2(1)
y = bereichLft & bereichRgt
End If
If y - x = 1 Or y - x = 2 Or y - x = 3 Or y - x = 4 Then
For l = 1 To lrow
If m = lrow Then
Exit Sub
End If
If Cells(l, 1) = xZahl Or Cells(l, 1) = yZahl Then
'Zählt bis zum nächsten Datum
Nrows = Cells(l, 1).End(xlDown).Row
'Zählt bis zur letzten leere Zelle
Rnumber1 = Cells(Rows.Count, 2).End(xlUp).Row + 1
End If
For k = l + 1 To Nrows - 2
If .Sheets(1).Range("C" & k + 1) <> "" Then '+ 1
'CompareRange fester Suchwert
Set CompareRange = Range("B" & k)
End If
For m = Nrows + 1 To Rnumber1 - 1
'b ist fester gesuchte Wert
For Each b In CompareRange
Set a = Range("B" & m)
If a = b Then a.Offset(0, 1) = b.Offset(0, 2) + _
a.Offset(0, 2)
Exit For
Next b
If a = b Then
Exit For
End If
Next m
Next k
Next l
End If
'aufräumen:
Set rngcell = Nothing: Set rngcell2 = Nothing
Loop
End With
End Sub
Beitrag wurde zuletzt am 17.07.16 um 08:22:23 editiert. | |
Re: Suchen und Finden bis zu 4 Jahren | | | Autor: Franki | Datum: 21.07.16 04:53 |
| Hallo,
deine Fragestellung ist etwas unverständlich, bescheibe doch mal in Umgangssprache was du machen möchest.
Z.B.: Finde alle Kunden die in den letzten 4 Monaten etwas gekauft haben, finde alle Kunden die in vier Monaten etwas gekauft haben usw. usw.
Mir ist noch nicht ganz klar was du erreichen möchtest. Aber als ersten Eindruck würde ich vorschlagen, dass du das mit SQL regelst bzw. einer Datenbank. Da bist du wesentlich flexibler als mit Excel alleine.
Gruß
Frank | |
Re: Suchen und Finden bis zu 4 Jahren | | | Autor: Coffee | Datum: 21.07.16 19:21 |
| Hallo Frank,
ich hatte heute Zeit und habe das Programm mit Adress und Len gelöst. So konnte ich gezielt die Zeilen ansprechen und die Begrenzungen einbauen. Noch ist mein Programm nicht fertig, aber den Rest versuche ich am Wochenende zu machen.
Trotzdem vielen Dank
Bei weiteren Fragen, hoffe ich auf Deine Hilfe
Bis Dann | |
| Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
|
|
sevOutBar 4.0
Vertikale Menüleisten á la Outlook
Erstellen von Outlook ähnlichen Benutzer- interfaces - mit beliebig vielen Gruppen und Symboleinträgen. Moderner OfficeXP-Style mit Farbverläufen, Balloon-Tips, u.v.m. Weitere InfosTipp des Monats TOP Entwickler-Paket
TOP-Preis!!
Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR...
Jetzt nur 599,00 EURWeitere Infos
|
|
|
Copyright ©2000-2024 vb@rchiv Dieter Otter Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.
Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel
|
|