Anzeige
Archiv - Navigation
304to308
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
304to308
304to308
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zellen ohne Inhalt beim kopieren überspringen

Zellen ohne Inhalt beim kopieren überspringen
08.09.2003 14:29:12
Kay
Hola zusammen,

ich habe zwei Probleme, auf die ich noch keine Lösung finden konnte.

1. Problem:

_______Spalte_A Spalte_B
Zeile 1___10______Ja
Zeile 2____5
Zeile 3___10______Ja

In Spalte_B ist eine Formel hinterlegt: =wenn(A1>9;"Ja";"")
Ich möchte nun alle "Ja" aus der Spalte B kopieren und in die Tballe2 kopieren und dabei die Leerzeilen überspringen, so dass in Tabelle2 folgendes steht:

_______Spalte_A
Zeile 1___Ja
Zeile 2___Ja

Die Zeile 2 wurde also ausgelassen, da hier kein Inhalt zu finden ist. Ich habe nun folgenden VBA Code:


Sub benoetigte_Schichten()
Application.ScreenUpdating = False
For I = 5 To 358
Sheets("benoetigte_Schichten_Umrechnung").Select
If (Range("D" & I).Value <> "") Then
Zaehler = Zaehler + 1
If (Range("E" & I).Value <> "") Then
Range("E" & I).Select
End If
Selection.Copy
Sheets("benötigte Schichten").Select
Range("A" & 2).Select
ActiveSheet.Paste
Sheets("benoetigte_Schichten_Umrechnung").Select
Range("D" & I).Select
Selection.Copy
Sheets("benötigte Schichten").Select
Range("B" & 2).Select
ActiveSheet.Paste
End If
Next I
Application.ScreenUpdating = True
Sheets("benötigte Schichten").Select
Range("A2").Select
End Sub


Ich habe in der Tabelle nicht nur ein "Ja" stehen, sondern einen variablen Text. Mein Ansatz war also folgender. Ich schaue nach Zellen, die einen Inhalt haben und selektiere diese. Es ist jedoch immer diese Formel hinterlegt, welche auch als "Inhalt" erkannt wird und daher nicht übersprungen wird, obgleich kein Inhalt zu sehen ist. Der Code Value <> "" muss also falsch sein. Ich könnte ja zunächst die Spalte_B kopieren und dann nur die Werte in eine Tabelle einfügen und dann das Script ablaufen lassen, dies wollte ich jedoch aus Gründen der Performance vermeiden. Wer kann mir helfen?

Problem 2:
Ich habe hier im Forum die Info bekommen, dass es keine Möglichkeit gibt innerhalb von Verkettungen (=Verketten(A1;" bis ";B1;C2)) Formatierungen zu hinterlegen, so dass der Inhalt von A1 beispielsweise "rot" dargestellt wir. Wie lauten denn die Alternativen zu Verketten? Ich wollte negative Werte in Zelle A1 rot darstellen und positive Standard.

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellen ohne Inhalt beim kopieren überspringen
08.09.2003 15:32:06
PeterW
Hallo Kay,

warum benutzt du als Bedingung für das Übertragen nicht einfach den Wert aus Spalte A? Du brauchst auch nicht jeden Wert per Copy und Paste zu übertragen, schreibe direkt
Sheets("Blabla").Cells(Zeile, Spalte) = Sheets("Blabla1").Cells(Zeile, Spalte).
Poste doch mal eine Beispielmappe, dann kann man den Code direkt passend dafür schreiben.

Gruß
Peter
AW: Zellen ohne Inhalt beim kopieren überspringen
08.09.2003 15:49:36
ChrisL
Hi Kay

Siehe Anhang

https://www.herber.de/bbs/user/930.xls

Option Explicit

Sub kopieren()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long

Set WS1 = Worksheets("Tabelle1")
Set WS2 = Worksheets("Tabelle2")

WS2.Range("A2:IV65536").ClearContents

For iZeile = 2 To WS1.Range("A65536").End(xlUp).Row
If WS1.Cells(iZeile, 2) <> "" Then _
WS1.Rows(iZeile).Copy WS2.Rows(WS2.Range("A65536").End(xlUp).Row + 1)
Next iZeile
End Sub


Sub Problem2()
Dim iZeile As Long

With Worksheets("Problem2")

.Columns(4).Font.ColorIndex = 0

For iZeile = 1 To .Range("A65536").End(xlUp).Row

.Cells(iZeile, 4) = "'" & .Cells(iZeile, 1) & " bis " & .Cells(iZeile, 2) & .Cells(iZeile, 3)

If .Cells(iZeile, 1) < 0 Then _
.Cells(iZeile, 4).Characters(Start:=2, Length:=Len(.Cells(iZeile, 1))).Font.ColorIndex = 3

If .Cells(iZeile, 2) < 0 Then _
.Cells(iZeile, 4).Characters(Start:=(Len(.Cells(iZeile, 1)) + 6), Length:=Len(.Cells(iZeile, 2))).Font.ColorIndex = 3

Next iZeile

End With
End Sub



bzw....

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column <= 3 Then
Dim iZeile As Long
With Worksheets("Problem2")
.Columns(4).Font.ColorIndex = 0
For iZeile = 1 To .Range("A65536").End(xlUp).Row
.Cells(iZeile, 4) = "'" & .Cells(iZeile, 1) & " bis " & .Cells(iZeile, 2) & .Cells(iZeile, 3)
If .Cells(iZeile, 1) < 0 Then _
.Cells(iZeile, 4).Characters(Start:=2, Length:=Len(.Cells(iZeile, 1))).Font.ColorIndex = 3
If .Cells(iZeile, 2) < 0 Then _
.Cells(iZeile, 4).Characters(Start:=(Len(.Cells(iZeile, 1)) + 6), Length:=Len(.Cells(iZeile, 2))).Font.ColorIndex = 3
Next iZeile
End With
End If
End Sub


Gruss
Chris
Anzeige
AW: Zellen ohne Inhalt beim kopieren überspringen
08.09.2003 17:37:10
Kay
Hola zusammen,

Danke Peter - Danke Chris!

Vielen Dank für eure Mühe. Ich hatte zwischenzeitlich mir den Code aus mehreren Beispielscripten zusammengebastelt. Er sieht wie folgt aus und funktioniert:


Sub Schichten_kopieren()
Application.ScreenUpdating = False
Sheets("benötigte Schichten blanko").Visible = True
Sheets("benoetigte_Schichten_Umrechnung").Visible = True
Sheets("benötigte Schichten blanko").Select
Cells.Select
Range("A3").Activate
Selection.Copy
Sheets("benötigte Schichten").Select
Cells.Select
Range("A3").Activate
ActiveSheet.Paste
Sheets("benoetigte_Schichten_Umrechnung").Select
Selection.AutoFilter Field:=1, Criteria1:="<>"
Range("D5:D358").Select
Selection.Copy
Sheets("benötigte Schichten").Select
Range("A6").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("benoetigte_Schichten_Umrechnung").Select
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=2, Criteria1:="<>"
Range("E5:E358").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("benötigte Schichten").Select
Range("B6").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("benoetigte_Schichten_Umrechnung").Select
Selection.AutoFilter Field:=2
Sheets("benötigte Schichten blanko").Visible = False
Sheets("benoetigte_Schichten_Umrechnung").Visible = False
Application.ScreenUpdating = True
Sheets("benötigte Schichten").Select
Range("A5").Select
End Sub


Ich werde aber gleich mal das Script von Chris ausprobieren. Es sieht einfach nicht so gebastelt aus....

Danke euch. :-)

Liebsten Gruß,
Kay.

P.S.: Habt Ihr für mein Problem 2 eine Idee?
Anzeige
AW: Zellen ohne Inhalt beim kopieren überspringen
08.09.2003 20:08:29
PeterW
Hallo Kay,

dein zweites Problem kannst du m.E. nur lösen, wenn du auf die Verkettung verzichtest und lediglich Zellbezüge herstellst und die Ausgabe auf mehrere Zellen verteilst und diese wie gewünscht formatierst.

Gruß
Peter
AW: Zellen ohne Inhalt beim kopieren überspringen
08.09.2003 20:18:33
ChrisL
Hi Kay

> P.S.: Habt Ihr für mein Problem 2 eine Idee?

Schau dir die Datei und Code einfach mal an.

Gruss
Chris

316 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige