VBA Werte zwischen zwei Zellen automatisch füllen
#1
Hallo liebe Community, 

Folgendes Problem.  In zelle C1 steht z.b der wert 2500 . In zelle F1 steht auch dieser wert also 2500. Ich möchte nun , dass excel in zelle A1 anfängt und die zeile 1,  zelle für zelle durchgeht.  Bis es an den wert in C1 (2500) kommt. Dann soll excel in jede weitere zelle ,also D1,E1, den wert aus C1 schreiben, Bis es an den wert in F1 kommt. Danach soll es nichts mehr schreiben. 

So soll Zeile für Zeile durchgegangen werden und die Werte zwischen den beiden vorgegeben werten ausfüllen.

In jeder Zeile befinden sich immer 2 mal der gleiche wert jedoch mit unterschiedlichen Abständen. Mal 2 Zellen,  mal 70 etc. 


Wie kann ich das automatisieren? 

Viele Grüße 

Sebi
Top
#2
Hallo Sebi,

vielleicht so?
Sub Makro2()
Dim rngB As Range, rngZ As Range
Dim varSp As Variant
Set rngB = Application.Intersect(Rows("3:" & Rows.Count), Columns(3).SpecialCells(xlCellTypeConstants))
For Each rngZ In rngB
varSp = Application.Match(rngZ.Value, rngZ.Offset(, 1).Resize(, Columns.Count - 4), 0)
If Not IsError(varSp) Then
rngZ.Offset(, 1).Resize(, varSp - 1).Value = rngZ.Value
End If
Next rngZ
End Sub
Gruß Uwe
Top
#3
Leider kommt beim ausführen die meldung in vba , "objekt erforderlich"

wie könnte ich das ändern ?

danke schon mal
Top
#4
       

also die daten sollen von rot nach grün geändert werden.

wie im bild
Top
#5
Hallo,

das kann ich Dir leider nicht beantworten. Blush

Gruß Uwe
Top
#6
Hallöchen,

hab bei Uwe auch nix entdeckt. Aber vielleicht geht es auch so. Übernommen wird immer die linke Zahl, egal, was rechts steht.

Voraussetzung:
1. Anfangs- -und Endzeile programmieren, z.B. 3 und 6
2. Dazwischen dürfen keine Leerzeilen sein
3. Es darf nicht in der ersten Spalte beginnen und der letzten aufhören
4. Es darf sonst nix in der Zeile stehen (außerhalb des Zahlenbereiches)
Werden die Bedingungen nicht eingehalten, muss man komplexer programmieren.

Code:
Sub test()
For icnt = 3 To 6
Range(Cells(icnt, Cells(icnt, 1).End(xlToRight).Column), _
   Cells(icnt, Cells(icnt, Columns.Count).End(xlToLeft).Column)) = _
     Cells(icnt, Cells(icnt, 1).End(xlToRight).Column)
Next
End Sub
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • SlimSebi
Top
#7
Thumbs Up 
Wow vielen lieben Dank.

Das funktioniert Perfekt
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste