vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevAniGif - als kostenlose Vollversion auf unserer vb@rchiv CD Vol.5  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Suche Visual-Basic Code
Suchen 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.
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Suchen und Finden bis zu 4 Jahren1.445Coffee17.07.16 08:14
Re: Suchen und Finden bis zu 4 Jahren559Franki21.07.16 04:53
Re: Suchen und Finden bis zu 4 Jahren554Coffee21.07.16 19:21

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

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

Copyright ©2000-2019 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