Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1184to1188
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
Inhaltsverzeichnis

Werte auffüllen wenn Spalte A gleich

Werte auffüllen wenn Spalte A gleich
lutz
Hallo Excel-Profis,
ich habe eine Tabelle die von Spalte A bis AK geht und eine variable Länge hat.
In Spalte A steht eine Rechnungsnummer. In den Spalten rechts daneben stehen manchmal keine Werte bzw. Sie werden nur einmal angezeigt.
Beispiel Rechnung 182 besteht aus 2 Positionen
Dann habe ich 3 Zeilen:
In der ersten stehen die Kundenstammdaten wie Name etc.
In den anderen beiden Zeilen sind die Kundenstammdaten leer aber z.B. der Artikel etc ist gefüllt.
Ich brauche ein Makro welches Fragt, ob in der Zeile in Spalte A der gleiche Wert wie darüber steht, und wenn ja dann soll er jede Leere Zelle mit dem Wert aus der Zeile darüber füllen.
Ich habe dieses schon mal getestet aber es geht nur mit einer Zeile und man muß manuell selektieren:
Sub CopyCellsleerobenjcSpalte()
Dim rng As Range
For Each rng In Selection.Columns(3).Cells
If Len(Trim$(rng)) = 0 And rng = rng.Offset(1, 0) Then rng = rng.Offset(-1, 0)
Next
End Sub
Weiß jemand eine Lösung?
Vielen Dank und Gruß Lutz
AW: Werte auffüllen wenn Spalte A gleich
16.11.2010 22:21:58
lutz
Hallo Lutz (Namensvetter - auch mal witzig),
vielen Dank.
Sub CopyCellsleerobenjcSpaltePetzold()
Dim lastRow As Long
Dim lngz1 As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For lngz1 = 1 To lastRow
If UCase(Cells(lngz1, 1) Like Cells(lngz1 + 1, 1)) Then
Range(Cells(lngz1, 2), Cells(lngz1, 37)).Copy _
Destination:=Range(Cells(lngz1 + 1, 2), Cells(lngz1 + 1, 37))
End If
Next
End Sub
Sieht ganz gut aus aber es gibt noch ein Problem: er überschreibt das immer - auch wenn schon etwas in der Zelle steht. Wenn man das noch abfragt (Zelle muß Leer sein) dann sollte es echt gehen.
Viele Grüße und Dank Lutz
Anzeige
ohne VBA, mit Hilfsspalte
17.11.2010 11:07:02
Klaus
Hallo Lutz eins,
ich würd das ganz klassisch mit Formeln in einer Hilfsspalte lösen, schau dir mal mein Beispiel an:
https://www.herber.de/bbs/user/72330.xls
Die Hilfsspalte kannst du auch per VBA mit der Formel versehen, dann kopieren-Inhalte einfügen in Spalte A und die Hilfsspalte löschen. Geht grad bei langen Listen bestimmt schneller als eine Schleife mit endlos vielen einzelnen Abfragen, und den Code dazu liefert dir notfalls der Makrorekorder.
Grüße,
Klaus M.vdT.
AW: ohne VBA, mit Hilfsspalte
17.11.2010 11:10:19
lutz
Hallo Klaus,
vielen Dank, leider kann ich in der CSV nicht noch weitere Daten eingeben - ich muß die Daten später noch mal weiterverarbeiten bzw. weiterkopieren.
Viele Grüße Lutz
Anzeige
AW: ohne VBA, mit Hilfsspalte
17.11.2010 11:15:57
Klaus
Hallo Lutz,
sicher dass es so nicht läuft? Probier mal den Code aus:
Sub RgNummer_Auffuellen()
Dim fRow As Long    'erste Zeile
Dim lRow As Long    'letzte Zeile
With ActiveSheet
fRow = .UsedRange.Row + 1 'plus eins, um unter die Überschrift zu kommen
lRow = .UsedRange.Rows.Count + .UsedRange.Row
'Hilfsspalte mit Formel füllen
.Range("AL" & fRow & ":AL" & lRow).FormulaR1C1 = "=IF(RC[-37]="""",IF(R[-1]C[-37]="""",R[-1] _
C,R[-1]C[-37]),RC[-37])"
'Zeile A mit Werten der Hilfsspalte überschreiben
.Range("A" & fRow & ":A" & lRow).Value = .Range("AL" & fRow & ":AL" & lRow).Value
'Hilfsspalte löschen
.Range("AL1").EntireColumn.ClearContents
End With
End Sub
(ich gehe davon aus dass in Spalte AL nichts steht, da du schreibst die Tabelle geht bis Spalte AK)
Grüße,
Klaus M.vdT.
Anzeige
AW: ohne VBA, mit Hilfsspalte
17.11.2010 11:36:25
lutz
Hallo Klaus,
vielen Dank.
Damit füllt er Spalte a aber die hat sowieso immer einen Wert. Und er bringt mir unten noch 2 zusätzliche Zeilen in Spalte a (wohl wegen der usedRange).
Ich habe jetzt eine Lösung die für jede Spalte für sich funktioniert:
Sub test8()
Dim Zeile As Integer
Dim Letzte As Integer
Zeile = 2
Letzte = Cells(Rows.Count, 1).End(xlUp).Row
Do
If (Cells(Zeile, 1)) = (Cells(Zeile - 1, 1)) Then
If IsEmpty(Cells(Zeile, 8)) Then
Range(Cells(Zeile, 8), Cells(Zeile, 8)).FillDown
End If
End If
Zeile = Zeile + 1
Loop Until Zeile > Letzte
End Sub
Sub test12()
Dim Zeile As Integer
Dim Letzte As Integer
Zeile = 2
Letzte = Cells(Rows.Count, 1).End(xlUp).Row
Do
If (Cells(Zeile, 1)) = (Cells(Zeile - 1, 1)) Then
If IsEmpty(Cells(Zeile, 12)) Then
Range(Cells(Zeile, 12), Cells(Zeile, 12)).FillDown
End If
End If
Zeile = Zeile + 1
Loop Until Zeile > Letzte
End Sub
D.h. ich muß jetzt für jede Spalte ein Makro machen... Das würde sicher mit irgeneiner variablen und einer Schleife auch in einem Rutsch gehen?!
Ich bin nur leider kein Schleifen-Programmierer - weißt Du das man anpassen müßte damit er das von Spalte 2 bis 36 macht? (Bzw. in der aktiven Range-Spaltenanzahl)
Vielen Dank schon einmal und Viele Grüße Lutz
Anzeige
nur noch eine Schleife fehlt
17.11.2010 12:11:20
lutz
Hallo,
ich habe jetzt die variablen definiert und er bringt auch die richtigen Werte. Aber der durchlauf der Schleifen läuft nicht:
Sub testAll()
Dim Zeile As Integer
Dim Spalte As Integer
Dim SpalteVgl As Integer
Dim Letzte As Integer
Dim LetzteSp As Integer
SpalteVgl = 1
Spalte = 2
Zeile = 2
Letzte = Cells(Rows.Count, 1).End(xlUp).Row
LetzteSp = Cells(1, Columns.Count).End(xlToLeft).Column
Do
Do
If (Cells(Zeile, SpalteVgl)) = (Cells(Zeile - 1, SpalteVgl)) Then
If IsEmpty(Cells(Zeile, Spalte)) Then
Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte)).FillDown
End If
End If
Zeile = Zeile + 1
Spalte = Spalte + 1
Loop Until Spalte > LetzteSp
Loop Until Zeile > Letzte
End Sub
Man muß wahrscheinlich nur die Schleifen umstellen?
Viele Grüße Lutz
Anzeige
AW: nur noch eine Schleife fehlt
17.11.2010 12:25:42
Lutz
Hallo Lutz,
meinst Du so,
Sub CopyCellsleerobenjcSpalte()
Application.ScreenUpdating = False
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For lngz1 = 1 To lastRow
If UCase(Cells(lngz1, 1) Like Cells(lngz1 + 1, 1)) Then
For intz1 = 2 To 37
If Cells(lngz1 + 1, intz1).Value = "" Then
Cells(lngz1, intz1).Copy _
Destination:=Cells(lngz1 + 1, intz1)
End If
Next
End If
Next
Application.ScreenUpdating = True
End Sub
oder soll immer von der jeweils ersten Zelle der Wert übernommen werden?
M.f.G.
Lutz
AW: nur noch eine Schleife fehlt
17.11.2010 12:37:17
lutz
Hi Lutz,
du bist meine Rettung - das geht jetzt.
Kannst Du mir als Schleifenkönig sagen, wie ich in diesen Code eine Schleife bekommen hätte die durch beides (Zeilen und Spalten) gelaufen wäre?
Sub testAll()
Dim Zeile As Integer
Dim Spalte As Integer
Dim SpalteVgl As Integer
Dim Letzte As Integer
Dim LetzteSp As Integer
SpalteVgl = 1
Spalte = 2
Zeile = 2
Letzte = Cells(Rows.Count, 1).End(xlUp).Row
LetzteSp = Cells(1, Columns.Count).End(xlToLeft).Column
Do
Do
If (Cells(Zeile, SpalteVgl)) = (Cells(Zeile - 1, SpalteVgl)) Then
If IsEmpty(Cells(Zeile, Spalte)) Then
Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte)).FillDown
End If
End If
Zeile = Zeile + 1
Spalte = Spalte + 1
Loop Until Spalte > LetzteSp
Loop Until Zeile > Letzte
End Sub

Ich möchte ja auch was lernen und nicht immer das Formum behelligen müßen.
Deine Lösung klappt natürlich perfekt - mich hat das jetzt fast einen Tag Recherche und basteln gekostet... (Hatte mir schon 37 einzelne Makros für jede Spalte gebastelt...)
Vielen lieben Dank und noch einen wunderschönen Tag, viele Grüße Lutz
Anzeige
AW: nur noch eine Schleife fehlt
17.11.2010 12:46:11
Lutz
Hallo Lutz,
ist Dein Problem nicht erledigt, wiel der Beitrag noch offen ist?
Wenn nicht, bitte Problem genauer beschreiben.
M.f.G.
Lutz
AW: nur noch eine Schleife fehlt
17.11.2010 12:56:07
lutz
Hallo Lutz,
doch ist eigentlich erledigt, ich wüßte nur gerne wie man meine Schleife ändern müßte damit es geht.
Man will das ja mal selber schaffen können.
Sonst ist alles perfekt, ist nur offen weil Du es wohl sonst nicht mehr gelesen hättest?!
vielen lieben Dank noch einmal.
Viele Grüße Lutz
AW: nur noch eine Schleife fehlt
17.11.2010 16:40:38
Lutz
Hallo Lutz,
schau Dir doch mal die Seiten unter dem nachfolgenden Link an.
Schöne Beispiele mit Beschreibungen.
http://www.online-excel.de/fom/fo_proaut.php?f=1&msg=1
M.f.G.
Lutz
Anzeige
AW: nur noch eine Schleife fehlt
17.11.2010 17:53:34
lutz
Hallo Lutz,
vielen Dank.
Ich werde mir das mal ansehen.
Viele liebe Grüße Lutz

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige