Anzeige
Archiv - Navigation
1040to1044
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

Daten beim kopieren bereits abschneiden

Daten beim kopieren bereits abschneiden
19.01.2009 10:02:00
Joachim
Hi,
ich kopiere mit folgendem Code Daten von einer Spalte zur anderen:
Worksheets("Temp").Range("CW2:CW1000").Copy Worksheets("data").Range("B10")
Inhalte sehen etwar so aus:
AUTO000005003
AUTO000005002
AUTO000005009
MOFA000004001
MOFA000004002
MOFA000004003
Daten, werden sauber kopiert, allerdings möchte ich das kopieren auf 10 Stellen begrenzen. also nach dem kopieren soll in Worksheets("data").Range("B10") nur noch:
AUTO000005
AUTO000005
AUTO000005
MOFA000004
MOFA000004
MOFA000004
steht.
Kann man das Kopieren auf die ersten 10 Zeichen begrenzen ?
Danke mal
Joachim

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten beim kopieren bereits abschneiden
19.01.2009 10:24:00
Peter
Hallo Joachim,
versuch es mit Worksheets("Temp").Range("CW2:CW1000").Copy Left(Worksheets("data").Range("B10"), 10)
Gruß Peter
AW: Daten beim kopieren bereits abschneiden
19.01.2009 10:59:58
Peter
Hallo Joachim,
das geht natürlich nicht, ich habe völlig übersehen, dass du einen Bereich kopieren willst.
Gruß Peter
kein Problem, trotzdem danke oT
19.01.2009 11:17:00
Joachim
AW: Daten beim kopieren bereits abschneiden
19.01.2009 10:31:46
Erich
Hallo Joachim,
hier mal zwei Möglichkeiten, bei denen allerdings nur die Werte kopiert werden,
also keine Formate usw.:

Option Explicit
Sub Test1()
Dim lngZ As Long
With Worksheets("data")
lngZ = Worksheets("Temp").Cells(.Rows.Count, 101).End(xlUp).Row
With .Cells(10, 2).Resize(lngZ - 1)
.Formula = "=LEFT(CW2,10)"
.Formula = .Value
End With
End With
End Sub
Sub Test2()
Dim lngZ As Long, arrT
With Worksheets("Temp")
lngZ = .Cells(.Rows.Count, 101).End(xlUp).Row
arrT = Application.Transpose(.Cells(2, 101).Resize(lngZ - 1))
End With
For lngZ = 1 To UBound(arrT)
arrT(lngZ) = Left(arrT(lngZ), 10)
Next lngZ
Worksheets("Temp").Cells(10, 2).Resize(UBound(arrT)) = arrT
End Sub

Bei beiden wird nicht bis Zeile 1000, sondern nur bis zur letzten in CW belegten Zeile gearbeitet.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: kleine Korrektur
19.01.2009 10:36:20
Erich
Hi,
in der letzten Zeile der Test2 muss natürlich Worksheets("data") stehen (statt "Temp").
Grüße von Erich aus Kamp-Lintfort
AW: kleine Korrektur
19.01.2009 11:06:26
Joachim
Hallo Erich,
wenn ich Deinen Code ausführe, dann werden zwar die Daten auf 10 Stellen begrenzt, aber die Inhalte ändern sich.
Dass heist, in allen Zellen steht nachher das Ergebnis, von meiner ersten Zelle. Also ich habe dann komplett duch überall den gleichen Eintrag.
Gruss
joachim
Wäre es nicht einfacher...
19.01.2009 11:20:05
Joachim
Hi Erich,
wäre es nicht einfachher, die Spalte Range("CW2:CW1000") VOR dem kopieren zu bearbeiten, und zwar so, dass nur noch max 10 zeichen drin steh, und zwar die ersten 10 oder allen über 10 abgeschnitten wird ?
Gruss
Joachim
Anzeige
AW: Wäre es nicht einfacher...
19.01.2009 11:20:00
Josef
Hallo Joachim,
Sub Copy10()
    Dim rngSource As Range, rngTarget As Range
    
    Set rngSource = Sheets("Temp").Range("CW2:CW1000")
    Set rngTarget = Sheets("Data").Range("B10").Resize(rngSource.Rows.Count, 1)
    
    rngTarget.Formula = "=LEFT('" & rngSource.Parent.Name & "'!" & _
        rngSource.Cells(1, 1).Address(0, 0) & ",10)"
    rngTarget = rngTarget.Value
    
    Set rngSource = Nothing
    Set rngTarget = Nothing
End Sub

Gruß Sepp

Anzeige
Danke Sepp, jetzt klappts oT
19.01.2009 12:09:27
Joachim
AW: größere Korrektur
19.01.2009 12:09:00
Erich
Hi Joachim,
sorry, da fehlte am Ende ein Application.Transpose.
Also noch mal:

Sub Test2()
Dim lngZ As Long, arrT
With Worksheets("Temp")
arrT = Application.Transpose( _
.Range(.Cells(2, 101), .Cells(.Rows.Count, 101).End(xlUp)))
End With
For lngZ = 1 To UBound(arrT)
arrT(lngZ) = Left(arrT(lngZ), 10)
Next lngZ
Worksheets("data").Cells(10, 2).Resize(UBound(arrT)) = Application.Transpose(arrT)
End Sub

Ich hoffe, jetzt läuft es - und dann auch noch mit dem gewünschten Ergebnis... ;-))
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
Danke, jetzt klapps oT
19.01.2009 15:29:00
Joachim
AW: Daten beim kopieren bereits abschneiden
19.01.2009 10:37:00
D.Saster
Hallo,
das kannst du nicht einfach begrenzen.

Sub Kopieren()
Dim vntTmp, i As Long
With Worksheets("Temp")
vntTmp = .Range(.Range("CW2"), .Range("CW65536").End(xlUp))
End With
For i = 1 To UBound(vntTmp)
If Len(vntTmp(i, 1) > 10) Then
vntTmp(i, 1) = Left(vntTmp(i, 1), 10)
End If
Next
Worksheets("Data").Range("B10").Resize(UBound(vntTmp)) = vntTmp
End Sub


Gruß
Dierk

AW: Noch einfacher...
20.01.2009 10:28:00
Tassos
Hallo!
Noch eine Alternative (benötigt eine leere Spalte):
Option Explicit

Sub Kopieren()
Dim c As Range
Set c = Worksheets("temp").Range("IV2:IV1000")
Worksheets("Temp").Range("CW2:CW1000").TextToColumns Destination:=c, _
DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(10, 9))
c.Cut Worksheets("data").Range("B10")
End Sub


Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige