Microsoft Excel

Herbers Excel/VBA-Archiv

Dif. auf X-Zellen gleich aufteilen | Herbers Excel-Forum


Betrifft: Dif. auf X-Zellen gleich aufteilen von: Thomas
Geschrieben am: 06.01.2010 16:50:58

Hallo zusammen im Forum,

ich steh vor einem problem wo ich nicht mehr weiter komme und eure hilfe brauche.
In Salte B7 steht das Datum und D,J Werte
01.01.2010// 24567,3// 12345,6
02.01.2010// 24789,0// 12380,1 letzter Eintrag
03.01.2010
.
.
06.01.2010 // 25001,5// 12780,2 neuer Eintrag
.
.
31.01.2010
Februar
01.02.2010
usw.

In D und J werden Ablesewerte eingetragen aber nicht täglich. Nun soll da aber keine Lücken in D und J sein sondern die Dif. vom neuem und altem Wert gleichmäßig verteilt und eingetragen werden.

So sollte es dann aussehen
02.01.2010// 24789,0// 12380,1 letzter Eintrag
03.01.2010// 24842,1// 12480,1
04.01.2010// 24895,3// 12580,1
05.01.2010// 24948,4// 12680,2
06.01.2010// 25001,5// 12780,2
Die Zeile mit den Monatnamen könnte ich auch aus der Tabelle nehmen wenn es sein müßte.
Klar am einfachsten ist es man trägt täglich die Werte ein fg.

Ich Dank Euch schon mal.

Gruß Thomas

  

Betrifft: Lücken gleichmäßig auffüllen von: Erich G.
Geschrieben am: 06.01.2010 17:50:03

Hi Thomas,
probier mal

Option Explicit

Sub Auffuellen()
   Dim lngS As Long, lngA As Long, lngE As Long, zz As Long, ss As Long
   Dim dblA As Double, dblP As Double
   
   For ss = 4 To 10 Step 6                         ' Spalten 4(D) und 10(J)
      lngS = Cells(Rows.Count, ss).End(xlUp).Row   ' letzte Zeile der Spalte
      lngA = 6                                     ' Suche ab Zeile 7
      lngE = 0
      While lngA < lngS And lngE < lngS
         While Not IsEmpty(Cells(lngA + 1, ss))
            If lngA > lngS Then Exit For
            lngA = lngA + 1                        ' Zeile lngA: letzter Eintrag
         Wend
         lngE = lngA + 1
         While IsEmpty(Cells(lngE, ss))
            If lngE > lngS Then Exit For
            lngE = lngE + 1                        ' Zeile lngE: neuer Eintrag
         Wend
         dblA = Cells(lngA, ss)                           ' Wert letzter Eintrag
         dblP = (Cells(lngE, ss) - dblA) / (lngE - lngA)  ' zu addieren
         For zz = lngA + 1 To lngE - 1
            Cells(zz, ss) = dblA + (zz - lngA) * dblP     ' Auffüllen
         Next zz
      Wend
   Next ss
End Sub
Falls in der Tabelle Zeilen nur mit Monatsnamen vorkommen, kann das stören - einfach probieren...

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Lücken gleichmäßig auffüllen von: Thomas
Geschrieben am: 06.01.2010 19:38:33

Hallo Erich,

Danke für die schnelle Antwort. Wie ich schon vermutete und du auch stört die Zeile mit dem Monatsnamen aber das ist kein problem (mehr).
Bin am überlegen ob ich nicht nun eine UF nehme um die Werte in meine Tabelle zu übertragen aber wie? Läßt sich das machen Textbox 1 für Wert in Spalte D und Textbox 2 für Wert in Spalte J, so das die Werte bei dem richtigen Datum dann eingetragen werden und in Spalte H die Zeit (hh:mm)? Ein Butten löst die Übertragung der Werte aus und dann dein Makro zum füllen.


  

Betrifft: AW: Lücken gleichmäßig auffüllen von: Thomas
Geschrieben am: 07.01.2010 11:38:14

Hallo Erich,

hab vergessen "Frage noch offen" zu Kennzeichnen sorry.
Hab mir die UF gemacht wo beim öffnen Datum und Zeit gleich da steht. Frage, wie bekomme ich die Werte in die richtige Zeile und die Zeit auch?

Gruß Thomas


  

Betrifft: Beispielmappe? von: Erich G.
Geschrieben am: 07.01.2010 12:53:56

Hi Thomas,
du schreibst: "Hab mir die UF gemacht".

Was sollte ich jetzt tun? Mir die UF nachbauen?
Vermutlich sähe sie bei mir etwas anders aus, die UF-Bestandteile hätten andere Namen, ...
Konsequenz: Deine und meine UF passen nicht zusammen, die Codes auch nicht.

Effektiver wäre, du würdest deine Mappe hochladen, dann kann ein Helfer daran arbeiten.

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Beispielmappe? von: Thomas
Geschrieben am: 07.01.2010 13:50:50

Hallo Erich,

hier die Mappe. https://www.herber.de/bbs/user/67041.xlsm

Gruß Thomas


  

Betrifft: AW: Beispielmappe? von: Thomas
Geschrieben am: 07.01.2010 14:20:20

Hi,

ich glaub der erste Versuch ist gleich mal nix hier der zweite Versuch.
https://www.herber.de/bbs/user/67043.xls

Das müsst gehen.

Gruß Thomas


  

Betrifft: Beispielmappe mit Code zurück von: Erich G.
Geschrieben am: 07.01.2010 18:26:31

Hi Thomas,
der zweite Versuch war besser - xl12 (2007) können mein Excel und ich nicht lesen. :-)

Etwas mehr Info darüber, wie sich das Programm in verschiedenen Situationen verhalten sollte,
wäre gut gewesen.

Was, wenn
- zu einem Datum schon Einträge existieren? (kommentarlos?) überschreiben?
- kein Wert1 oder Wert2 eingegeben wird? jeweils 0,0 in die Zellen schreiben?
- das eingegebene Datum noch nicht in der Tabelle vorkommt? (eintragen und Datumse evtl. auffüllen?)

Schau dir mal an, was ich in der Mappe so umgesetzt habe.

Wesentlich ist, dass das 1. Datum in B7 steht und in den Zeilen darunter jeweils genau 1 Tag weiter.
Die kompletten Spalten B, D, G und J haben das jeweils passende Zahlenformat bekommen.
Die Routine zum Auffüllen war nicht ok, habe ich geändert.

Und hier die Mappe zurück: https://www.herber.de/bbs/user/67052.xls

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Beispielmappe mit Code zurück von: Thomas
Geschrieben am: 07.01.2010 19:11:54

Hallo Erich,

das ist genau das wie ich es haben möchte. Zu deinen bedenken wegen fehlendem Datum kann ich sagen, das ich die Tabelle bis 31.12. geführt habe und die Zeilen mit den Monatsnamen sind gelöscht. Auch werden immer beide Werte eingetragen, lauf ja nicht 2 mal zum ablesen hin wenn die Zahlen keine 12 cm voneinander weg liegen.
Du hast recht man könnte da was einbauen aber das möcht ich mal selbst als Übung für mich versuchen.

Ich Dank Dir für die Hilfe, ist einfach Klasse wie hier jedem geholfen wird. Lese fast täglich die Beiträge mit oder gehe auf die suche hier um mir selbst zu helfen.

Wünsch Dir einen schönen Abend noch.

Gruß Thomas


Beiträge aus den Excel-Beispielen zum Thema "Dif. auf X-Zellen gleich aufteilen"