Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
780to784
780to784
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Spezielles Kopieren/Einfügen mit VBA

Spezielles Kopieren/Einfügen mit VBA
13.07.2006 14:27:03
Torsten
Hallo beisammen,
ich habe ein Problem, das ich mit meinen bescheidenen VBA-Kenntnissen nicht alleine lösen kann.
Ich erhalte regelmäßig vom Konzern eine tief gegliederte Produkthierarchie, die ich für meine Belange weiter bearbeiten muß - bis jetzt noch manuell, was aber ziemlich mühsam ist, weil die Datei bis zu 1.700 Zeilen hat.
Ich brauche also einen Code, der folgendes macht:
Die Spalte A ab der Zeile 8 solange durchsuchen, bis er einen Eintrag findet, diesen plus einen entsprechenden den Eintrag in der Spalte B kopiert und solange in die Zeilen darunter einfügt, bis er entweder einen neuen Eintrag findet und diesen Vorgang wiederholt oder der Eintrag auf "EOF" lautet.
Das ganze soll dann für die Spalten C, E, G und I wiederholt werden.
Zum besseren Verständnis habe ich Test-Datei beigefügt.
Es wäre super, wenn Ihr mir weiterhelfen könntet. Vielen Dank im voraus.
Gruß
Torsten
https://www.herber.de/bbs/user/35053.xls

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spezielles Kopieren/Einfügen mit VBA
13.07.2006 15:11:17
Ralf
Hi Torsten,
wenn ein Landwirt das Geld für's Hühnerfutter sparen will wird er wohl nicht mehr lange Eier verkaufen können.
Was will Dein Konzern bald nicht mehr verkaufen?
Betriebliche Komplettlösungen (und seien sie auch noch so klein) zum Nulltarif ohne Eigenanteil wirst Du sicher in keinem Forum erhalten.
Ciao, Ralf
AW: Spezielles Kopieren/Einfügen mit VBA
13.07.2006 15:40:51
Torsten
Hallo Ralf,
schönen Dank für Deine Rückmeldung.
Wenn Du keine Lust hast, mir weiter zu helfen - kein Problem. Zu berücksichtigen wäre allerdings, daß wahrscheinlich 90% der Threads hier auf betrieblichen Fragestellungen beruhen, also Fragen und Probleme beim Arbeiten mit Excel am Arbeitsplatz entstehen. Ob es sich dabei um einen Konzern oder um eine kleine Personengesellschaft handelt, spielt doch wohl keine Rolle. Wenn ich hier jeden Tag Fragen aufwerfen würde, die einen professionellen Programmierer den ganzen Tag beschäftigen würden, wäre ich geneigt, Deine Einstellung zu teilen. Das tue ich aber nun mal nicht.
Wenn hier also jeder denkt wie Du, kann das Forum bald schließen.
Ich bin aber überzeugt, daß ich zu meiner Fragestellung noch eine Hilfe hier erhalte.
Schönen Tag noch und
Gruß
Torsten
Anzeige
AW: Spezielles Kopieren/Einfügen mit VBA
13.07.2006 16:04:58
holli
Hallo Torsten,
versuchs mal damit:

Sub Spalte_ausfuellen()
Dim a
a = 9
Do Until Cells(a, 1).Value = "EOF"
If Cells(a, 1).Value = "" And Cells(a - 1, 1).Value <> "" Then
Cells(a - 1, 2).Select
Selection.Copy
Cells(a, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(a, 1).Value = "" Then
Cells(a - 1, 1).Select
Selection.Copy
Cells(a, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
a = a + 1
Loop
a = 9
Do Until Cells(a, 3).Value = "EOF"
If Cells(a, 3).Value = "" And Cells(a - 1, 3).Value <> "" Then
Cells(a - 1, 4).Select
Selection.Copy
Cells(a, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(a, 3).Value = "" Then
Cells(a - 1, 3).Select
Selection.Copy
Cells(a, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
a = a + 1
Loop
a = 9
Do Until Cells(a, 5).Value = "EOF"
If Cells(a, 5).Value = "" And Cells(a - 1, 5).Value <> "" Then
Cells(a - 1, 6).Select
Selection.Copy
Cells(a, 5).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(a, 5).Value = "" Then
Cells(a - 1, 5).Select
Selection.Copy
Cells(a, 5).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
a = a + 1
Loop
a = 9
Do Until Cells(a, 7).Value = "EOF"
If Cells(a, 7).Value = "" And Cells(a - 1, 7).Value <> "" Then
Cells(a - 1, 8).Select
Selection.Copy
Cells(a, 7).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(a, 7).Value = "" Then
Cells(a - 1, 7).Select
Selection.Copy
Cells(a, 7).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
a = a + 1
Loop
a = 9
Do Until Cells(a, 9).Value = "EOF"
If Cells(a, 9).Value = "" And Cells(a - 1, 9).Value <> "" Then
Cells(a - 1, 10).Select
Selection.Copy
Cells(a, 9).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(a, 9).Value = "" Then
Cells(a - 1, 9).Select
Selection.Copy
Cells(a, 9).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
a = a + 1
Loop
End Sub

Gruß
Holli
Anzeige
AW: Spezielles Kopieren/Einfügen mit VBA
13.07.2006 16:25:27
Torsten
Hallo Holli,
vielen Dank für Deine Rückmeldung.
Es stimmt noch nicht ganz. :-(
Leider wird das, was er in Spalte B findet in Spalte A kopiert. Richtig wäre, wenn er in Spalte A einen Eintrag findet, diesen Wert sowie den Eintrag eine Zelle weiter in Spalte B zu kopieren und in die Zeilen darunter zu kopieren, bis ein neuer Eintrag gefunden wird. Es sieht aber so aus, als hättest Du bald die Lösung.
Falls ich mich heute auf eine weitere Nachricht von Dir nicht mehr melde, hole ich das morgen selbstverständlich nach.
Gruß
Torsten
AW: Spezielles Kopieren/Einfügen mit VBA
13.07.2006 16:55:53
holli
Hi Torsten,
meinst Du so?

Sub Spalte_ausfuellen()
Dim a
a = 9
Do Until Cells(a, 1).Value = "EOF"
If Cells(a, 1).Value = "" And Cells(a - 1, 1).Value <> "" Then
Cells(a, 2).Select
ActiveCell.FormulaR1C1 = "=R[-1]C[-1]&R[-1]C"
Else
If Cells(a, 1).Value = "" Then
Cells(a, 2).Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
End If
End If
a = a + 1
Loop
a = 10
Do Until Cells(a, 3).Value = "EOF"
If Cells(a, 3).Value = "" And Cells(a - 1, 3).Value <> "" Then
Cells(a, 4).Select
ActiveCell.FormulaR1C1 = "=R[-1]C[-1]&R[-1]C"
Else
If Cells(a, 3).Value = "" Then
Cells(a, 4).Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
End If
End If
a = a + 1
Loop
a = 11
Do Until Cells(a, 5).Value = "EOF"
If Cells(a, 5).Value = "" And Cells(a - 1, 5).Value <> "" Then
Cells(a, 6).Select
ActiveCell.FormulaR1C1 = "=R[-1]C[-1]&R[-1]C"
Else
If Cells(a, 5).Value = "" Then
Cells(a, 6).Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
End If
End If
a = a + 1
Loop
a = 12
Do Until Cells(a, 7).Value = "EOF"
If Cells(a, 7).Value = "" And Cells(a - 1, 7).Value <> "" Then
Cells(a, 8).Select
ActiveCell.FormulaR1C1 = "=R[-1]C[-1]&R[-1]C"
Else
If Cells(a, 7).Value = "" Then
Cells(a, 8).Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
End If
End If
a = a + 1
Loop
a = 13
Do Until Cells(a, 9).Value = "EOF"
If Cells(a, 9).Value = "" And Cells(a - 1, 9).Value <> "" Then
Cells(a, 10).Select
ActiveCell.FormulaR1C1 = "=R[-1]C[-1]&R[-1]C"
Else
If Cells(a, 9).Value = "" Then
Cells(a, 10).Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
End If
End If
a = a + 1
Loop
End Sub

Gruß
Holli
Anzeige
AW: Spezielles Kopieren/Einfügen mit VBA
14.07.2006 10:12:20
Torsten
Hallo Holli,
das wäre eine Lösung gewesen, allerdings wollte ich keine Formeln einfügen, weil erstens die Datei an sich schon relativ groß ist und ich außerdem mit den Daten weiterarbeiten möchte; da sind Werte besser als Formeln.
Da die Lösung von fcs genau das ist, was ich brauche, möchte ich mich bei Dir für Deine Bemühungen bedanken. Schönes Wochenende und
Gruß
Torsten
AW: Spezielles Kopieren/Einfügen mit VBA
13.07.2006 16:35:32
fcs
Hallo Thorsten,
im Grunde muß ich Ralf recht geben. Die Lösung des Problems ist verhältnismäßig einfach. Die Tabelle ist per VBA in wenigen Sekunden aufbereitet statt evtl. 1 bis 2 Std. Handarbeit. Da sollte der Konzern für jemanden der Excel hauptberuflich nutzt auch schon mal eine entsprechende Schulung in VBA ermöglichen.
In diesem Sinne hier mein Vorschlag.
mfg
Franz

Sub InfosAuffuellen()
Dim wks As Worksheet, Zeile As Long, Zeile1 As Long
Set wks = ActiveWorkbook.Sheets("Basis")
Zeile1 = 8 ' 1. Zeile mit Daten
With wks
'Spalten A und B
Zeile = Zeile1
Do
If IsEmpty(.Cells(Zeile + 1, "A")) Then
.Cells(Zeile + 1, "A") = .Cells(Zeile, "A")
.Cells(Zeile + 1, "B") = .Cells(Zeile, "B")
End If
Zeile = Zeile + 1
Loop Until .Cells(Zeile, "A") = "EOF"
'Spalten C und D
Zeile = Zeile1
Do
If IsEmpty(.Cells(Zeile + 1, "C")) And .Cells(Zeile + 1, "A") = .Cells(Zeile, "A") Then
.Cells(Zeile + 1, "C") = .Cells(Zeile, "C")
.Cells(Zeile + 1, "D") = .Cells(Zeile, "D")
End If
Zeile = Zeile + 1
Loop Until .Cells(Zeile, "C") = "EOF"
'Spalten E und F
Zeile = Zeile1
Do
If IsEmpty(.Cells(Zeile + 1, "E")) _
And .Cells(Zeile + 1, "A") = .Cells(Zeile, "A") And .Cells(Zeile + 1, "C") = .Cells(Zeile, "C") Then
.Cells(Zeile + 1, "E") = .Cells(Zeile, "E")
.Cells(Zeile + 1, "F") = .Cells(Zeile, "F")
End If
Zeile = Zeile + 1
Loop Until .Cells(Zeile, "E") = "EOF"
'Spalten G und H
Zeile = Zeile1
Do
If IsEmpty(.Cells(Zeile + 1, "G")) _
And .Cells(Zeile + 1, "A") = .Cells(Zeile, "A") _
And .Cells(Zeile + 1, "C") = .Cells(Zeile, "C") _
And .Cells(Zeile + 1, "E") = .Cells(Zeile, "E") Then
.Cells(Zeile + 1, "G") = .Cells(Zeile, "G")
.Cells(Zeile + 1, "H") = .Cells(Zeile, "H")
End If
Zeile = Zeile + 1
Loop Until .Cells(Zeile, "G") = "EOF"
'Spalten I und J
Zeile = Zeile1
Do
If IsEmpty(.Cells(Zeile + 1, "I")) _
And .Cells(Zeile + 1, "A") = .Cells(Zeile, "A") _
And .Cells(Zeile + 1, "C") = .Cells(Zeile, "C") _
And .Cells(Zeile + 1, "E") = .Cells(Zeile, "E") _
And .Cells(Zeile + 1, "G") = .Cells(Zeile, "G") Then
.Cells(Zeile + 1, "I") = .Cells(Zeile, "I")
.Cells(Zeile + 1, "J") = .Cells(Zeile, "J")
End If
Zeile = Zeile + 1
Loop Until .Cells(Zeile, "I") = "EOF"
End With
End Sub

Anzeige
erledigt mT
14.07.2006 10:23:30
Torsten
Hallo Franz,
zunächst mal herzlichen Dank für Deine perfekte Lösung. Genau das, was ich brauchte! :-))
Zu Deiner Eingangsbemerkung: In der Tat hat mich mein Arbeitgeber zu einer VBA-Schulung geschickt. Allerdings ist die Schulung das eine, tägliche Praxis und Übung das andere. Hauptberuflich bin ich Controller und kein Excel-Programmierer und nach Aussage meines Chefs soll das auch so bleiben. So gerne ich mich mit Excel und VBA auch mehr beschäftigen möchte, ich habe auch Familie und kann mich nicht ausschließlich mit Excel beschäftigen. Die Aufgabenstellung mag für den geübten VBA-Anwender "relativ" einfach sein, für mich war das noch zu hoch. Aber ich kann an Hand Deiner Lösung ja auch dazulernen.:-)
Daher nochmals vielen Dank für Deine Hilfe.
Schönes Wochenende und
Gruß
Torsten
Anzeige

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige