PDA

Vollständige Version anzeigen : Zwischenablage -> Text zu Spalten - Makro/Script automatisch ausführen


ÜberNeuntausend
11.04.2012, 13:23
Hallo,

ich stehe vor einem Problem: Ich möchte aus der Zwischenablage Daten in eine Tabelle einfügen, die Pasta sieht in etwa so aus:
0 12 801 0 2
Das ganze soll von der Zwischenablage in eine neue Zeile eingefügt werden, wobei jedes Element eine separate Spalte bekommt (eben wie die Text-zu-Spalten-Funktion), die Formatierung der unteren Zeile soll benutzt werden. Das ganze müsste sich ja mit dem Visual-Basic-Editor ganz gut lösen lassen, allerdings bin ich vom Funktionsumfang etwas erschlagen und finde die passenden Befehle nicht.

Dazu kommt, dass das ganze jedesmal ausgeführt werden soll, wenn eine passende Zahlenfolge in der Zwischenablage ist (die nicht der letzten Verarbeiteten entspricht), ist eine Endlosschleife dafür die beste Lösung?

Gruß

CitizenX
11.04.2012, 15:16
Hi,

da aus deiner Beschreibung nicht hervorging wo die Daten eingefügt werden sollen,
hab ich's mal so gelöst, dass die Werte aus der Zwischenablage von der aktiven Zelle ausgehend eingefügt werden:


Code in ein allgemeines Modul

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> ClipboardText()
<span class="TOKEN">Dim</span> oClipBoard <span class="TOKEN">As</span> Object, vTemp
<span class="TOKEN">Static</span> oldValue <span class="TOKEN">As</span> <span class="TOKEN">String</span>
&nbsp;
<span class="TOKEN">Set</span> oClipBoard = CreateObject(&quot;new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}&quot;)
<span class="TOKEN">On Error GoTo</span> ErrExit
&nbsp;
oClipBoard.GetFromClipboard
vTemp = Split(Replace(oClipBoard.GetText, Chr(32), vbCrLf), vbCrLf)
&nbsp;
<span class="TOKEN">If</span> <span class="TOKEN">UBound</span>(vTemp) <span class="TOKEN">Then</span>
<span class="TOKEN">If</span> oldValue &lt;&gt; Join(vTemp, vbCrLf) <span class="TOKEN">Then</span>
<span class="REM"> ' Daten aus ClipBoard einf&uuml;gen</span>
ActiveCell.Resize(, <span class="TOKEN">UBound</span>(vTemp)) = vTemp
<span class="REM"> ' Formatierung von den nachfolge Zellen &uuml;bernehmen</span>
<span class="TOKEN">With</span> ActiveCell.Resize(, <span class="TOKEN">UBound</span>(vTemp))
.Interior.ColorIndex = ActiveCell.Resize(, <span class="TOKEN">UBound</span>(vTemp)).Offset(1, 0).Interior.ColorIndex
.Font.ColorIndex = ActiveCell.Resize(, <span class="TOKEN">UBound</span>(vTemp)).Offset(1, 0).Font.ColorIndex
.Font.FontStyle = ActiveCell.Resize(, <span class="TOKEN">UBound</span>(vTemp)).Offset(1, 0).Font.FontStyle
.Font.Bold = ActiveCell.Resize(, <span class="TOKEN">UBound</span>(vTemp)).Offset(1, 0).Font.Bold
.NumberFormat = ActiveCell.Resize(, <span class="TOKEN">UBound</span>(vTemp)).Offset(1, 0).NumberFormat
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
<span class="REM"> ' alte Werte speichern</span>
oldValue = Join(vTemp, vbCrLf)
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
&nbsp;
ErrExit:
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;</pre></div>
Code eingefügt mit dem MOF Code Converter (http://www.ms-office-forum.net/forum/codeconverter.php)

ÜberNeuntausend
11.04.2012, 18:09
Das sieht ja schon prima aus! Vielen Dank für deine Mühe.
Allerdings werden die Zahlen als Text ausgegeben (steht in den Zellen als Warnung) und die Formatierung wird nur teilweise (nämlich nur der Rahmen) übernommen. Woran liegt das? Im Code steht es ja eigentlich drin.

CitizenX
11.04.2012, 18:21
Hi,

ich hab noch eine andere Variante in petto, bekomme sie aber erst heut Abend fertig -muss los...

ebs17
11.04.2012, 18:25
Dazu kommt, dass das ganze jedesmal ausgeführt werden soll, wenn eine passende Zahlenfolge in der Zwischenablage ist (die nicht der letzten Verarbeiteten entspricht), ist eine Endlosschleife dafür die beste Lösung?
Die Begriffe Zwischenablage und "beste Lösung" schließen einander aus, schon weil man nicht sicher weiß, was sich gerade in der Zwischenablage befindet.

Was machst Du, wenn statt Pasta Kohlköpfe "angeboten" werden?

ÜberNeuntausend
11.04.2012, 18:32
Im Grunde reicht es, die Anzahl der Leerzeichen zu zählen - die ist immer gleich, während die Werte dazwischen anders sind. Alternativ kann man auch gucken, ob nur Zahlen enthalten sind - oder beides zusammen. Das bekomme ich hin ;)
Was für eine Alternative würdest du denn vorschlagen? Ich könnte mir auch einen Button vorstellen, oder eine Aktivierung per Hotkey - ist dann eben nicht mehr ganz so bequem.

CitizenX
11.04.2012, 23:25
Hi,

kopiere den Code ins Modul deiner Tabelle in der du die Werte einfügen möchtest.

Im Codeteil ist der Bereich der Gültigkeit vorgegeben,nur hier werden die Werte eingefügt:

If Intersect(Target, Range("A1:B10")) Is Nothing Then Exit Sub

den Bereich muss du natürlich anpassen.

Es wird vor dem Einfügen geprüft ob Numerische Werte mit Leerzeichen enthalten sind.

Das Makro wird ausgeführt wenn du gültige Werte kopiert hast und mit dem Cursor in deinem Bereich der Tabelle eine Zelle auswählst.



Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim oClipBoard As Object, Regex As Object
Dim strTemp As String, vTemp

Set oClipBoard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Set Regex = CreateObject("VBscript.Regexp")
Static oldValue As String

' !!! Bereich der Gültigkeit anpassen !!!
If Intersect(Target, Range("A1:B10")) Is Nothing Then Exit Sub

On Error GoTo ErrExit

oClipBoard.GetFromClipboard

strTemp = Trim$(Replace(Replace(oClipBoard.GetText, vbCrLf, Chr(32)), vbTab, Chr(32)))
vTemp = Split(strTemp)

Regex.Global = True
Regex.Pattern = "[^0-9 ]"

' prüfen ob Numerische Werte in Zwischenablage sind aktueller Wert ungleich Neuer Wert
If Not Regex.Test(strTemp) And oldValue <> strTemp Then
' Daten aus ClipBoard einfügen
Target = strTemp
Application.DisplayAlerts = False
'in den Spalten aufteilen
Target.TextToColumns Destination:=Target
' Formatierung von den nachfolge Zellen übernehmen
Target.Resize(, UBound(vTemp) + 1).Offset(1, 0).Copy
Target.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
' alte Werte speichern
oldValue = strTemp
End If

ErrExit: Application.DisplayAlerts = True
End Sub

ÜberNeuntausend
12.04.2012, 01:10
Wow! Danke sehr, das klappt super! Klick und schwupp (^_^)
Kannst du noch einbauen, dass es automatisch eine Zeile einfügt, so dass die Werte quasi immer in eine neue Zeile unter der angeklickten Zelle wandern.
Und wie ändert man denn den Integer (wenn das so heißt), dass er auch Kommazahlen nimmt? Das ist im Moment nicht so wichtig, aber vielleicht später.

CitizenX
12.04.2012, 01:30
Hi,

So?

Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim oClipBoard As Object, Regex As Object
Dim strTemp As String, vTemp

Set oClipBoard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Set Regex = CreateObject("VBscript.Regexp")
Static oldValue As String

' !!! Bereich der Gültigkeit anpassen !!!
If Intersect(Target, Range("A1:B10")) Is Nothing Then Exit Sub

On Error GoTo ErrExit

oClipBoard.GetFromClipboard

strTemp = Trim$(Replace(Replace(oClipBoard.GetText, vbCrLf, Chr(32)), vbTab, Chr(32)))
vTemp = Split(strTemp)

Regex.Pattern = "[^0,|\.1-9,|\.9 ]"

' prüfen ob Numerische Werte in Zwischenablage sind aktueller Wert ungleich Neuer Wert
If Not Regex.Test(strTemp) And oldValue <> strTemp Then
' Daten aus ClipBoard einfügen
Target = strTemp
Application.DisplayAlerts = False
'in den Spalten aufteilen
Target.TextToColumns Destination:=Target
' Formatierung von den nachfolge Zellen übernehmen
Target.Resize(, UBound(vTemp) + 1).Offset(1, 0).Copy
Target.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
' neue Zeile einfügen
Target.EntireRow.Insert
' alte Werte speichern
oldValue = strTemp
End If

ErrExit: Application.DisplayAlerts = True
End Sub

Überneuntausend
12.04.2012, 10:49
Perfekt! Alles astrein, vielen besten Dank!