Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 09:26:26
Median für Zeilen mit gleichen Zeitstempel
19.04.2024 08:41:23
Zwei Makros in ein Arbeitsblatt - zweite wird nicht ausführt
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
968to972
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
968to972
968to972
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Texterkennung

Texterkennung
15.04.2008 14:08:41
maxi
Wie kann ich erreichen, dass Zellen aus einem bestimmten Bereich übertragen werden auf einen anderen Bereich, wenn ein spezifischer Text in den Zellen steht?

27
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Benimmregeln
15.04.2008 14:11:00
Knigge

Entschuldigung
15.04.2008 14:40:00
maxi
Entschuldigung, das war nicht bewusst vorgenommen. War ein bisschen in Eile : )
Ich versuchs am besten nochmal:
Hallo Zusammen,
Ich hab vorliegende Frage zu lösen: Zellen aus einem bestimmten Bereich sollen übertragen werden auf einen anderen Bereich, wenn ein spezifischer Text in den Zellen steht?
Kann mir jmd. helfen?
Viele Grüße
PS: Danke für den Hinweis, war echt nicht so gemeint.

AW: Entschuldigung
15.04.2008 14:49:00
Jonatan
Hallo,
ich weißt, ob du das gemeint hast.
Soll dann der ganze Bereich, oder nur eine Zelle kopiert werden?
Gruß Jonatan

Sub kopierBereich()
Dim c As Range
For Each c In Range("A5:B10") 'Hier musst du deinen Bereich reinschreiben
If c.Value = "Hallo" Then ' Zwischen die Hochkommas deinen Text
Range("A5:B10").Copy Destination:=Range("C8") 'Hier die Zieladresse
End If
Next c
End Sub


Anzeige
AW: Entschuldigung
15.04.2008 14:50:00
Renee
Hi Maxi,
Warum formulierst du deinen Beitrag so allgemein.
Nützt dir den eine Angabe wie:

If  TabelleX.Range("SpezifischeZelle") = "Spezifischer Text" Then
TabelleX.Range("SpezifischerBereich").Copy Destination:=TabelleY.Range("Zielbereich")
End If


etwas ?
GreetZ Renée

AW: Entschuldigung
15.04.2008 15:06:41
maxi
Hallo,
ich versuchs genauer.
Wenn in einer Zelle der Spalten B (von Zeile 5-1900) oder G (von Zeile 5-1900) Öl, Eisen oder Kupfer steht. Sollen die Zellen der gleichen Zeile in den Spalten A-D für Eintritt in Spalte B oder in den Spalten F-I für einen Eintritt in Spalte G verschoben werden in die jeweils gleichen Spalten aber halt andere Zeilen wie z.B. 2000-2002.
Die Grundideen sahen aber schon ansatzweise gut aus.
Gruß

Anzeige
AW: Eintritt / verschieben
15.04.2008 15:43:00
Renee
Hi Maxi,
Ich versteh nicht was du unter Eintritt und unter verschieben verstehst!
Kannst du nicht einfach mal so eine Aktion mit dem Makrorekorder aufzeichnen.
Dann stell den Code ins Forum und wir können vlt. verallgemeinern.
GreetZ Renée

AW: Eintritt / verschieben
15.04.2008 16:13:00
maxi
Hallo Renée,
Ganz kurz: Mit Eintritt meine ich das Vorkommen der Begriffe Öl, Eisen, Schwefel oder Kupfer in den Spalten B (Zeile 5 bis 1500) oder G (Zeile 5 bis 1500).
Verschieben soll die Bewegung der Zellen von z.B. A5, B5, C5, D5, da in B5 Eisen steht, in die Zellen A2000, B2000, C2000 und D2000 darstellen. Nach der Verschiebung stehen die Zellen A5, B5, C5, D5, da in B5 leer (oder können auch gelöscht werden mit Hochschieben des Bereichs drunter um die leeren Zellen zu belegen)
Steht jetzt zusätzlich z.B. in G203 Schwefel drin, dann werden F203, G203, H203 und I203 in die Zellen F2000, G2000, H2000 und I2000 verschoben. Nach der Verschiebung stehen die Zellen F203, G203, H203 und I203 leer (oder können auch gelöscht werden mit Hochschieben des Bereichs drunter um die leeren Zellen zu belegen)
Weiter könnte jetzt in G700 Öl stehen, dann werden F700, G700, H700 und I700 in die Zellen F2001, G2001, H2001 und I2001 verschoben, da diese unmittelbar unter der zuvor belegten Zellen in Zeile 2000 angefügt werden sollen. F700, G700, H700 und I700 stehen leer (oder können auch gelöscht werden mit Hochschieben des Bereichs drunter um die leeren Zellen zu belegen)
Ich weis nicht ob ich das mit dem Makro Rekorder hinkriege. Ich versuchs jetzt aber mal.
Viele Grüße
Maxi

Anzeige
Kopieren
15.04.2008 14:53:00
Beverly
Hi Maxi,

Sub kopieren()
If Application.WorksheetFunction.CountIf(Range("B4:F20"), "Hallo") > 0 Then _
Range("B4:F20").Copy Range("J10")
End Sub



Verschieben
15.04.2008 15:33:53
maxi
Hallo,
Weniger kopieren, es sollte eher eine Verschiebung stattfinden.
Wenn in einer Zelle der Spalten B (von Zeile 5-1900) oder G (von Zeile 5-1900) Öl, Eisen, Schwefel oder Kupfer steht. Sollen die Zellen der gleichen Zeile in den Spalten A-D für Eintritt in Spalte B oder in den Spalten F-I für einen Eintritt in Spalte G verschoben werden in die jeweils gleichen Spalten aber halt andere Zeilen wie z.B. 2000-2003.
Die Grundideen sahen aber schon ansatzweise gut aus.
Freundlichst grüßt
Maxi

Anzeige
AW: Verschieben
15.04.2008 15:59:20
Erich
Hallo Maxi,
probier mal 

Sub kopieren2()
Dim strSuch, ii As Integer, rngF As Range, lngZ As Long, lngF As Long
Dim rngSuch(1) As Range, jj As Integer, lngSpV(1), lngSpB(1)
Dim lngZiel As Long, lngZneu As Long
strSuch = Split("Öl Eisen Kupfer")                    ' Suchbegriffe
Set rngSuch(0) = Range(Cells(5, 2), Cells(1900, 2))   ' Suchbereich 1
Set rngSuch(1) = Range(Cells(5, 7), Cells(1900, 7))   ' Suchbereich 2
lngSpV(0) = 1:   lngSpB(0) = 4                        ' Copy Spalten 1
lngSpV(1) = 6:   lngSpB(1) = 9                        ' Copy Spalten 2
lngZiel = 2000                                        ' Zielzeile ab
For ii = 0 To UBound(strSuch)
For jj = 0 To 1
lngZneu = lngZiel
With rngSuch(jj)
Set rngF = .Find(What:=strSuch(ii), after:=rngSuch(jj)(1, 1), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
If Not rngF Is Nothing Then
lngZ = rngF.Row
lngF = lngZ
Do
Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj))).Copy _
Cells(lngZneu, lngSpV(jj))
Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj))).ClearContents
lngZneu = lngZneu + 1
Set rngF = .FindNext(rngF)
If rngF Is Nothing Then
lngZ = lngF
Else
lngZ = rngF.Row
End If
Loop While lngZ

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

Anzeige
AW: Verschieben
15.04.2008 16:36:00
maxi
Hi Erich,
habs ausprobiert. Die Zellen werden erkannt und rausgenommen aber noch nicht auf Zeile 2000 verpflanzt. Also die fehlen einfach.
Ich hatte auch noch unter einer Spalte eine Summe der oben aufgeführten Mengen stehen. Diese Summe verändert sich komischerweise nicht, obwohl jetzt die rausgenommenen Mengen fehlen.
Hast du noch irgendeine Idee?
Gruß
Maxi

AW: Verschieben
15.04.2008 19:25:14
Erich
Hi Maxi,
sorry, da war noch ein Fehler drin - ich habe die Reihenfolge
der Schleifen noch vertauscht: 

Sub kopieren2()
Dim strSuch, ii As Integer, rngF As Range, lngZ As Long, lngF As Long
Dim rngSuch(1) As Range, jj As Integer, lngSpV(1), lngSpB(1)
Dim lngZiel As Long, lngZneu As Long
Sheets(1).Activate
Cells.Clear
Sheets(2).UsedRange.Copy Cells(1, 1)
strSuch = Split("Öl Eisen Kupfer")                    ' Suchbegriffe
Set rngSuch(0) = Range(Cells(5, 2), Cells(1900, 2))   ' Suchbereich 1
Set rngSuch(1) = Range(Cells(5, 7), Cells(1900, 7))   ' Suchbereich 2
lngSpV(0) = 1:   lngSpB(0) = 4                        ' Copy Spalten 1
lngSpV(1) = 6:   lngSpB(1) = 9                        ' Copy Spalten 2
lngZiel = 2000                                        ' Zielzeile ab
For jj = 0 To 1
lngZneu = lngZiel
For ii = 0 To UBound(strSuch)
With rngSuch(jj)
Set rngF = .Find(What:=strSuch(ii), after:=rngSuch(jj)(1, 1), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
If Not rngF Is Nothing Then
lngZ = rngF.Row
lngF = lngZ
Do
Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj))).Copy _
Cells(lngZneu, lngSpV(jj))
Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj))).ClearContents
lngZneu = lngZneu + 1
Set rngF = .FindNext(rngF)
If rngF Is Nothing Then
lngZ = lngF
Else
lngZ = rngF.Row
End If
Loop While lngZ

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

Anzeige
AW: Verschieben
15.04.2008 19:32:00
Erich
Hi Maxi,
in der neuen Version sind oben drei Testzeilen drin, die sicher stören:
Sheets(1).Activate
Cells.Clear
Sheets(2).UsedRange.Copy Cells(1, 1)
Diese Zeilen musst du löschen.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

AW: Verschieben
16.04.2008 11:50:28
maxi
Morgen Erich,
die neue Version funktioniert. Danke!
Jedoch werden die Zellen nicht fixiert, d.h. die Zeilen in die verschoben wird stehen dann in der Formel die die eigentlich die Zeilen aus der sie verschoben wurden stehen (beibehalten werden) sollten.
Ich hätte anfangs noch anfügen sollen, dass die Zellen die verschoben werden sollen Formeln enthalten, Sorry.
Kann man die Fixierung zu verschiebender Zellen ermöglichen?
Gruß
Maxi

Anzeige
AW: Verschieben
16.04.2008 10:01:58
Erich
Hi Maxi,
hier noch ne Version, ber der nun auch die geleerten Zellen gelöscht werden: 

Sub kopieren4()
Dim strSuch, ii As Integer, rngF As Range, lngZ As Long, lngF As Long
Dim rngSuch(1) As Range, jj As Integer, lngSpV(1), lngSpB(1)
Dim lngZiel As Long, lngAnz As Long, rngC As Range, rngA As Range
strSuch = Split("Öl Eisen Kupfer")                    ' Suchbegriffe
Set rngSuch(0) = Range(Cells(5, 2), Cells(1900, 2))   ' Suchbereich 1
Set rngSuch(1) = Range(Cells(5, 7), Cells(1900, 7))   ' Suchbereich 2
lngSpV(0) = 1:   lngSpB(0) = 4                        ' Copy Spalten 1
lngSpV(1) = 6:   lngSpB(1) = 9                        ' Copy Spalten 2
lngZiel = 2000                                        ' Zielzeile ab
For jj = 0 To 1
lngAnz = 0
For ii = 0 To UBound(strSuch)
With rngSuch(jj)
Set rngF = .Find(What:=strSuch(ii), after:=.Cells(.Rows.Count, .Columns.Count), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not rngF Is Nothing Then
lngZ = rngF.Row
lngF = lngZ
Do
If rngC Is Nothing Then
Set rngC = Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj)))
Else
Set rngC = Union(rngC, _
Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj))))
End If
Set rngF = .FindNext(rngF)
If rngF Is Nothing Then lngZ = lngF Else lngZ = rngF.Row
lngAnz = lngAnz + 1
Loop While lngZ > lngF
End If
End With
Next ii
For Each rngA In rngC.Areas
rngA.Copy Cells(lngZiel + lngAnz, lngSpV(jj))
rngA.Delete xlShiftUp
Next rngA
Set rngC = Nothing
Next jj
End Sub

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

Anzeige
AW: Verschieben
16.04.2008 12:07:00
maxi
Morgen Erich,
die neue Version funktioniert. Danke!
Jedoch werden die Zellen nicht fixiert, d.h. die Zeilen in die verschoben wird stehen dann in der Formel die die eigentlich die Zeilen aus der sie verschoben wurden stehen (beibehalten werden) sollten.
Ich hätte anfangs noch anfügen sollen, dass die Zellen die verschoben werden sollen Formeln enthalten, Sorry.
Kann man die Fixierung zu verschiebender Zellen ermöglichen?
Gruß
Maxi

AW: Verschieben
16.04.2008 12:38:03
maxi
Hi Erich,
beim Löschen der Zellen wird die Verscheibung der Zellen nach Zeile 2000 nicht vorgenommen. Sie werden lediglich gelöscht.
Das löschen der Zellen ist nicht so wichtig, ich tendiere eher dazu bei der ersten Version zu bleiben. die fand ich super, bis auf die noch fehlende Fixierung halt.
Wenn, dann würde ich noch einen Button hinterlegen um die Verschiebung rückgängig machen zu können bei Bedarf.
Damit wäre ich aber bedient denke ich.
Gruß
Maxi

Anzeige
Fixierung
16.04.2008 14:50:00
maxi
Hallo,
kann mir jemand beim Fixieren von Zellinhalten (nicht Funktionen der Zellen) für dieses Makro:

Sub kopieren2()
Dim strSuch, ii As Integer, rngF As Range, lngZ As Long, lngF As Long
Dim rngSuch(1) As Range, jj As Integer, lngSpV(1), lngSpB(1)
Dim lngZiel As Long, lngZneu As Long
Sheets(1).Activate
Cells.Clear
Sheets(2).UsedRange.Copy Cells(1, 1)
strSuch = Split("Öl Eisen Kupfer")                    ' Suchbegriffe
Set rngSuch(0) = Range(Cells(5, 2), Cells(1900, 2))   ' Suchbereich 1
Set rngSuch(1) = Range(Cells(5, 7), Cells(1900, 7))   ' Suchbereich 2
lngSpV(0) = 1:   lngSpB(0) = 4                        ' Copy Spalten 1
lngSpV(1) = 6:   lngSpB(1) = 9                        ' Copy Spalten 2
lngZiel = 2000                                        ' Zielzeile ab
For jj = 0 To 1
lngZneu = lngZiel
For ii = 0 To UBound(strSuch)
With rngSuch(jj)
Set rngF = .Find(What:=strSuch(ii), after:=rngSuch(jj)(1, 1), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
If Not rngF Is Nothing Then
lngZ = rngF.Row
lngF = lngZ
Do
Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj))).Copy _
Cells(lngZneu, lngSpV(jj))
Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj))).ClearContents
lngZneu = lngZneu + 1
Set rngF = .FindNext(rngF)
If rngF Is Nothing Then
lngZ = lngF
Else
lngZ = rngF.Row
End If
Loop While lngZ

behilflich sein?
Viele Grüße

Fixierung
16.04.2008 14:56:00
maxi
Hallo,
kann mir jemand beim Fixieren von Zellinhalten (nicht Funktionen der Zellen), die nach diesem Makro verschoben werden sollen behilflich sein?

Sub kopieren2()
Dim strSuch, ii As Integer, rngF As Range, lngZ As Long, lngF As Long
Dim rngSuch(1) As Range, jj As Integer, lngSpV(1), lngSpB(1)
Dim lngZiel As Long, lngZneu As Long
Sheets(1).Activate
Cells.Clear
Sheets(2).UsedRange.Copy Cells(1, 1)
strSuch = Split("Öl Eisen Kupfer")                    ' Suchbegriffe
Set rngSuch(0) = Range(Cells(5, 2), Cells(1900, 2))   ' Suchbereich 1
Set rngSuch(1) = Range(Cells(5, 7), Cells(1900, 7))   ' Suchbereich 2
lngSpV(0) = 1:   lngSpB(0) = 4                        ' Copy Spalten 1
lngSpV(1) = 6:   lngSpB(1) = 9                        ' Copy Spalten 2
lngZiel = 2000                                        ' Zielzeile ab
For jj = 0 To 1
lngZneu = lngZiel
For ii = 0 To UBound(strSuch)
With rngSuch(jj)
Set rngF = .Find(What:=strSuch(ii), after:=rngSuch(jj)(1, 1), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
If Not rngF Is Nothing Then
lngZ = rngF.Row
lngF = lngZ
Do
Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj))).Copy _
Cells(lngZneu, lngSpV(jj))
Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj))).ClearContents
lngZneu = lngZneu + 1
Set rngF = .FindNext(rngF)
If rngF Is Nothing Then
lngZ = lngF
Else
lngZ = rngF.Row
End If
Loop While lngZ


Viele Grüße

AW: Verschieben
16.04.2008 18:07:12
Erich
Hi Maxi,
hier werden die Formeln in den zu verschiebenden Zellen vor der Verschiebung
durch Werte ersetzt: 

Sub kopieren5()
Dim strSuch, ii As Integer, rngF As Range, lngZ As Long, lngF As Long
Dim rngSuch(1) As Range, jj As Integer, lngSpV(1), lngSpB(1)
Dim lngZiel As Long, lngAnz As Long, rngC As Range, rngA As Range
strSuch = Split("Öl Eisen Kupfer")                    ' Suchbegriffe
Set rngSuch(0) = Range(Cells(5, 2), Cells(1900, 2))   ' Suchbereich 1
Set rngSuch(1) = Range(Cells(5, 7), Cells(1900, 7))   ' Suchbereich 2
lngSpV(0) = 1:   lngSpB(0) = 4                        ' Copy Spalten 1
lngSpV(1) = 6:   lngSpB(1) = 9                        ' Copy Spalten 2
lngZiel = 2000                                        ' Zielzeile ab
For jj = 0 To 1
lngAnz = 0
For ii = 0 To UBound(strSuch)
With rngSuch(jj)
Set rngF = .Find(What:=strSuch(ii), after:=.Cells(.Rows.Count, .Columns.Count), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not rngF Is Nothing Then
lngZ = rngF.Row
lngF = lngZ
Do
If rngC Is Nothing Then
Set rngC = Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj)))
Else
Set rngC = Union(rngC, _
Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj))))
End If
Set rngF = .FindNext(rngF)
If rngF Is Nothing Then lngZ = lngF Else lngZ = rngF.Row
lngAnz = lngAnz + 1
Loop While lngZ > lngF
End If
End With
Next ii
For Each rngA In rngC.Areas
With rngA
.Value = .Value            ' hier werden Formel durch Werte ersetzt
.Copy Cells(lngZiel + lngAnz, lngSpV(jj))
.Delete xlShiftUp
End With
Next rngA
Set rngC = Nothing
Next jj
End Sub

Ob das alles sinnvoll ist, sei dahingestellt.
Rückgängig lässt es sich jedenfalls nicht so einfach machen.
Was ist mit Formeln, die sich auf die gelöschten Zellen beziehen?
Ganz gut wäre eine Beispielmappe gewesen.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

AW: Verschieben
16.04.2008 18:19:23
maxi
Hallo Erich,
leider komm ich erst morgen früh dazu es zu prüfen.
Mit rückgangig machen sei noch kurz erklärt, dass bei bedarf die Zellen die ausgeblendet wurden wieder eingeblendet werden können. D.h., ich hab einmal eine Auflistung ohne Öl, Eisen usw. und dann möchte ich nochmal schauen wie die Auflistung nochmal aussieht falls Öl, Eisen usw. wieder miteinbezogen werden..
Schließlich steht ja unten eine Summe und ein direkter Vergleich wäre nützlich, in dieser Form zumindest.
Gruss und schönen Tag noch,
bis morgen Früh
Maxi

AW: Bereiche bedingt verschieben
17.04.2008 11:54:45
Erich
Hi Maxi,
ja, so eine Beispielmappe hilft sehr - und hätte zu Beginn des Threads noch viel mehr geholfen...
In dieser Mappe findest du 4 Möglichkeiten. Allen gemeinsam ist, dass nicht Formeln,
sondern Werte nach unten übertragen werden.
https://www.herber.de/bbs/user/51648.xls
Unterschiede gibts in zwei Richtungen:
- Mal werden die Formate mitkopiert (damit verschwindet der gelbe Hintergrund), mal nicht.
- Mal werden die nach unten übertragenen Zellen gelöscht, mal nur geleert.
Noch eine Bemerkung:
Die Summen würde ich ÜBER dem zu summierenden Bereich hinschreiben.
Du weißt doch voher vermutlich nicht, wie viele Zeilen übertragen werden.
Wenn's mal mehr sind, ist die Summe plötzlich futsch...
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

AW: Bereiche bedingt verschieben
17.04.2008 13:40:40
maxi
Hallo Erich,
erstmal wollte ich anmerken, dass das schonmal klasse aussieht. Gelb sind die Flächen eigentlich garnicht. Ich wollte das nur hervorheben.
Was ich jetzt gerne hätte, wäre das Makro für Auflistung-6. Also kein löschen der Zellen sondern nur leeren. Die Übertragung nach unten ist genau so wie ich es mir vorgestellt habe.
Da ich mich nicht so gut auskenne, weis ich auch nicht wo das Makro, dass du verwendet hast im Excel steht. Könntest du mir sagen wo ich es finde, und zur Sicherheit nochmal so im Thread aufschreiben wie die Makros zuvor?
Das mit den Summen habe ich jetzt so verstanden: Unter den Überschriften in der nächstfolgenden Zeile würden die Summen stehen. Falls jetzt ein Eintrag kommt (also eine Verschiebung von der Tabelle oben nach unten) schiebt sich die Summe runter.um die verschobenen Zeilen nach unten. D.h. der Eintrag findet immer zwischen Summe und Überschrift statt. Nach unten hin wären keine Grenzen gesetzt.
Ich weis aber auch nicht wie so etwas zu programmieren wäre.
Viele Grüße
Maxi

AW: Bereiche bedingt verschieben
17.04.2008 15:48:08
Erich
Hi Maxi,
schaust du dir die Mappe bitte noch mal etwas genauer an?
Wenn du schreibst "wäre das Makro für Auflistung-6. Also kein löschen der Zellen sondern nur leeren.",
zeigt mir das, dass du den Unterschied zwischen Auflistung-3 und Auflistung-6 nicht wirklich gesehen hast:
In Auflistung-3 sind die Zellen oben nur geleert, in Auflistung-6 sind sie gelöscht.
(In G8 steht vorher "Öl". in Auflistung-3 ist G8 nachher leer, in Auflistung-6 steht darin jetzt "Holz",
die vier Zellen zu "Holz" sind dadurch nach oben gerutscht, dass die Zellen F8:I8 gelöscht wurden.
In Auflistung-3 stehen die oberen Summen wie vorher in Zeile 24,
in Auflistung-6 sind sie wegen der Löschungen nach oben in Zeile 19 bzw. 20 gerutscht.
Wenn du das willst: "Also kein löschen der Zellen sondern nur leeren",
wären das die Blätter Auflistung-2 oder Auflistung-3.
Du schreibst auch: "Gelb sind die Flächen eigentlich gar nicht."
Also dürfte dir egal sein, ob du Auflistung-2 oder Auflistung-3 nimmst.
Diese beiden unterscheiden sich NUR dadurch, dass bei Auflistung-3 nur die Werte,
bei Auflistung-2 auch die Formate nach unten übertragen werden.
(Analoges gilt für Auflistung-6 und Auflistung-5.)
Die Zahlen 2, 3, 5, 6 haben etwas zu bedeuten:
Das Makro kopieren2 produziert Auflistung-2,
das Makro kopieren3 produziert Auflistung-3 usw.
Da kannst du also einfach die nicht gebrauchten Makros löschen.
Das mit den Summen habe ich anders gemeint:
Wenn die (unteren) Summen z. B. in Zeile 29 stehen,
in Zeile 30 die Überschriften, die neuen Zeilen dann ab Zeile 31.
als =summe(D31:D65000) bzw. =summe(I31:I65000)
dann können darunter ziemlich viele Zeilen gefüllt und summiert werden,
ohne dass die Zeile mit den Summen zu verschieben wäre.
Der Bereich unterhalb der übertragenen Werte ist und bleibt leer.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

AW: Bereiche bedingt verschieben
18.04.2008 10:21:00
maxi
Hallo Erich,
hab mich für Makro 2 entschieden, klappt super.
Vielen Dank!
Ohne dich hätte ich das nie hingekriegt.
Viele Grüße
Maxi

Fehler
17.04.2008 08:25:00
maxi
Morgen,
hab das Makro jetzt mal durchlaufen lassen. Die Zellen, die verschoben werden sollten wurden wie zuvor gelöscht. Da ich aber lieber die andere Version verwende mit dem aublenden ohne hochzuschieben hab ich versucht das letzt geschriebene Makro, das Formeln in Werte umwandelt auf das Makro mit dem Ausblenden zu übertragen. Es muss noch irgendwo ein Fehler drin stecken. Ich hab mal den Laufzeitfehler der mir angezeigt wird fett gemacht.

Sub kopieren5()
Dim strSuch, ii As Integer, rngF As Range, lngZ As Long, lngF As Long
Dim rngSuch(1) As Range, jj As Integer, lngSpV(1), lngSpB(1)
Dim lngZiel As Long, lngZneu As Long
strSuch = Split("Öl Eisen Kupfer")                    ' Suchbegriffe
Set rngSuch(0) = Range(Cells(5, 2), Cells(1900, 2))                                          _
' Suchbereich 1
Set rngSuch(1) = Range(Cells(5, 7), Cells(1900, 7))                                          _
' Suchbereich 2
lngSpV(0) = 1:   lngSpB(0) = 4                                                               _
' Copy Spalten 1
lngSpV(1) = 6:   lngSpB(1) = 9                                                               _
' Copy Spalten 2
lngZiel = 2000                                                                               _
' Zielzeile ab
For jj = 0 To 1
lngZneu = IngZiel
For ii = 0 To UBound(strSuch)
With rngSuch(jj)
Set rngF = .Find(What:=strSuch(ii), after:=rngSuch(jj)(1, 1), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
If Not rngF Is Nothing Then
lngZ = rngF.Row
lngF = lngZ
Do
Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj))).Copy _
Cells(lngZneu, lngSpV(jj))
Range(Cells(lngZ, lngSpV(jj)), Cells(lngZ, lngSpB(jj))).ClearContents
lngZneu = lngZneu + 1
Set rngF = .FindNext(rngF)
If rngF Is Nothing Then
lngZ = lngF
Else
lngZ = rngF.Row
End If
Loop While lngZ


Gibts dafür eine Lösung?
Viele Grüße Maxi

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige