Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

VBA nur Zellen mit Inhalt kopieren

491 views
Skip to first unread message

Jörg Kaiser

unread,
Mar 26, 2007, 5:45:27 AM3/26/07
to
Hallo

Ich möchte mit Excel VBA nur Text aus dem Bereich T2:T20 kopieren
und in den Bereich L2:L20 einfügen. Dabei wäre zu beachten, dass auch
Text schon unter L vorhanden sein kann, der nicht überschrieben werden
darf. Es ist aber so, das pro Zeile immer nur 1x Text pro Spalte
vorhanden ist (ist L2 leer so ist der Eintrag in T2 und umgekehrt)
Für Eure Mithilfe wäre ich sehr dankbar, da ich absoluter Anfänger
bin und würde mich freuen, wenn Ihr auch eine kleine kurze
Beschreibung zu Eurer Lösung schreibt, damit ich es besser
verstehe :-).

Mit freundlichen Grüßen Jörg Kaiser

chfa

unread,
Mar 26, 2007, 6:07:59 AM3/26/07
to
hallo Jörg Kaiser,

ich würde das so versuchen

public const NAME as String = "Test"
public const ZIELBEREICH as String "L1:L22"
public const QUELLSPALTE as String = T
public const THISROW as Integer = 0

dim zelleSrc as range, _
zelleDst as range, _
textWert as String

set zelleDst = worksheet(NAME).Range(ZIELBEREICH)

for each textWert in zelle

if zelle.Value = "" Then
set zelleSrc=worksheet(NAME).Range(QUELLSPALTE & zelleDst.row)
zelleDst.value= zelleSrc.value
end if ' Leere Zelle entdeckt: füllen

next textWert

set zelleDst = nothing
set zelleSrc = Nothing

Andere Varianten (for.. next, do while/until ..loop, do... loop while/
until, etc. ) sind auch möglich

(:
ChFa


Thomas Ramel

unread,
Mar 26, 2007, 7:33:43 AM3/26/07
to
Grüezi Jörg

Jörg Kaiser schrieb am 26.03.2007

Die folgenden Zeilen kopieren nur die Textwerte aus Spalte L in dieselbe
Zeile der Spalte T:

Dim rngZelle As Range
For Each rngZelle In Range("L2:L20").SpecialCells(xlCellTypeConstants, 2)
rngZelle.Offset(0, 8).Value = rngZelle.Value
Next rngZelle

Mit freundlichen Grüssen
Thomas Ramel (@work)

--
- MVP für Microsoft-Excel -
[Win XP Pro SP-2 / xl2003 SP-1]
Microsoft Excel - Die ExpertenTipps tinyurl.com/cmned

Jörg Kaiser

unread,
Mar 27, 2007, 4:28:22 AM3/27/07
to
Hallo ChFa und Thomas

Erst mal Vielen Dank an Euch Beide

Thomas
Habe Deine Prozedur etwas umgestellt da Quellspalte T ist und nach L
eingefügt werden soll.
Funktioniert . Habe nur noch ein kleines Problem: Und zwar kann es
vorkommen( habe ich leider vergessen im 1. Posting zu erwähnen), dass
in der Spalte T keine Einträge sind und da kommt " Laufzeitfehler". Da
die Prozedur nur Teil eines Makros werden soll ( es werden noch andere
Spalten danach gelöscht und verschoben ) sollte auch dies
berücksichtigt werden. Kannst Du mir da bitte noch mal helfen?

Dim rngZelle As Range
For Each rngZelle In

Range("T2:T20").SpecialCells(xlCellTypeConstants, 2)
rngZelle.Offset(0, -8).Value = rngZelle.Value
Next rngZelle


MfG Jörg

Claus Busch

unread,
Mar 27, 2007, 4:44:14 AM3/27/07
to
Hallo Jörg,

Am 27 Mar 2007 01:28:22 -0700 schrieb Jörg Kaiser:

> Habe Deine Prozedur etwas umgestellt da Quellspalte T ist und nach L
> eingefügt werden soll.
> Funktioniert . Habe nur noch ein kleines Problem: Und zwar kann es
> vorkommen( habe ich leider vergessen im 1. Posting zu erwähnen), dass
> in der Spalte T keine Einträge sind und da kommt " Laufzeitfehler". Da
> die Prozedur nur Teil eines Makros werden soll ( es werden noch andere
> Spalten danach gelöscht und verschoben ) sollte auch dies
> berücksichtigt werden. Kannst Du mir da bitte noch mal helfen?

probiers mal so:


Dim rngZelle As Range
For Each rngZelle In Range("T2:T20")

If Not IsNumeric(rngZelle) Then
rngZelle.Offset(0, -8).Value = rngZelle.Value
End If
Next


--
Mit freundlichen Grüssen
Claus Busch

Win XP Prof SP2; Office 2000 SP3
claus_busch(at)t-online.de

Jörg Kaiser

unread,
Mar 27, 2007, 5:35:30 AM3/27/07
to
On 27 Mrz., 10:44, Claus Busch <claus_bu...@nospam.de> wrote:
> probiers mal so:
> Dim rngZelle As Range
> For Each rngZelle In Range("T2:T20")
> If Not IsNumeric(rngZelle) Then
> rngZelle.Offset(0, -8).Value = rngZelle.Value
> End If
> Next

Hallo Claus
Habe es gerade probiert und es "FUNKTIONIERT"

Vielen Dank an Dich und auch noch mal an die anderen Mithelfer :-)

MfG Jörg

Thomas Ramel

unread,
Mar 27, 2007, 8:18:35 AM3/27/07
to
Grüezi Jörg

Jörg Kaiser schrieb am 27.03.2007

> Habe Deine Prozedur etwas umgestellt da Quellspalte T ist und nach L
> eingefügt werden soll.

Sorry, dann hab ich das durcheinander gebracht

> Funktioniert . Habe nur noch ein kleines Problem: Und zwar kann es
> vorkommen( habe ich leider vergessen im 1. Posting zu erwähnen), dass
> in der Spalte T keine Einträge sind und da kommt " Laufzeitfehler". Da
> die Prozedur nur Teil eines Makros werden soll ( es werden noch andere
> Spalten danach gelöscht und verschoben ) sollte auch dies
> berücksichtigt werden. Kannst Du mir da bitte noch mal helfen?

Entweder mit einem harten 'On Error Resume Next'
oder dann mit einer Prüfung ob überhaupt Werte im Quellbereich enthalten
sind:

Dim rngZelle As Range
If Application.WorksheetFunction.CountA(Range("T2:T20")) > 0 Then


For Each rngZelle In Range("T2:T20").SpecialCells(xlCellTypeConstants, 2)
rngZelle.Offset(0, -8).Value = rngZelle.Value
Next rngZelle

End If

Jörg Kaiser

unread,
Mar 28, 2007, 4:10:18 AM3/28/07
to
Hallo Thomas


On 27 Mrz., 14:18, Thomas Ramel <t.ra...@MVPs.org> wrote:
>> Entweder mit einem harten 'On Error Resume Next'
> oder dann mit einer Prüfung ob überhaupt Werte im Quellbereich enthalten

> Dim rngZelle As Range


> If Application.WorksheetFunction.CountA(Range("T2:T20")) > 0 Then
> For Each rngZelle In Range("T2:T20").SpecialCells(xlCellTypeConstants, 2)
> rngZelle.Offset(0, -8).Value = rngZelle.Value
> Next rngZelle

Habe es soeben probiert und es funktioniert ebenfalls genau so wie ich
es mir vorgestellt habe.
1000 Dank

MfG Jörg

0 new messages