ich habe ein Problem, wenn in einer Zelle (Spalte I ab Zelle3) der Wert größer ist als 4 stellen,
soll dieser Wert ausgeschnieden und 2 spalten nach rechts verschoben werden,
geht das ?
Die Gesamtlänge ist 10.000 Zellen.
gruß kurt k
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.AddressLocal > "$I$3" Then
If IsNumeric(Target.Value) Then
If Len(Target.Value) - InStr(Target.Value, ",") > 4 Then
Selection.Cut
ActiveCell.Offset(0, 2).Activate
ActiveSheet.Paste
End If
End If
End If
End Sub
Sub Offset()
Dim r1 As Range
Set r1 = Range("A1:AA1000")
For Each c In r1
Dim Adr() As String
Adr = Split(c.AddressLocal, "$")
If Adr(1) >= "I" And Adr(2) > 3 Then
If IsNumeric(c.Value) Then
If Len(c.Value) - InStr(c.Value, ",") > 4 Then
Selection.Cut
ActiveCell.Offset(0, 2).Activate
ActiveSheet.Paste
End If
End If
End If
Next
End Sub
G | H | I | J | K | |
2 | alle | alle / kurz | lang | ||
3 | 1234567 | 1234567 | |||
4 | 123456 | 123456 | |||
5 | -234567 | -234567 | |||
6 | -23456 | -23456 | |||
7 | 12345 | 12345 | |||
8 | 0 | 0 | |||
9 | 123,567 | 123,567 | |||
10 | 123,56 | 123,56 | |||
11 | -234,6 | -234,6 | |||
12 | -234,67 | -234,67 | |||
13 | -12,3000% | -0,123 | |||
14 | -12,3400% | -0,1234 | |||
15 | abcdefg | abcdefg | |||
16 | abcdef | abcdef |
Private Sub cbStart_Click()
Dim lngZ As Long, arQ, arZ(), zz As Long
lngZ = Cells(Rows.Count, 9).End(xlUp).Row - 2 ' Anz. Zeilen ab Zeile 3
arQ = Cells(3, 9).Resize(lngZ) ' Quellspalte in Array (Sp. I=9)
ReDim arZ(1 To lngZ, 1 To 1) ' Zieldaten anlegen
For zz = 1 To lngZ
If Len(arQ(zz, 1)) > 6 Then ' wenn Länge > 6 ?
arZ(zz, 1) = arQ(zz, 1) ' Übertrag in Zieldaten
arQ(zz, 1) = Empty ' Löschen in Quelldaten
End If
Next zz
Cells(3, 9).Resize(lngZ, 1) = arQ ' Ausgabe in Quellspalte (I=9)
Cells(3, 11).Resize(lngZ, 1) = arZ ' Ausgabe in Zielspalte (K=11)
End Sub
Und hier eine BeiSpielMappe: https://www.herber.de/bbs/user/80459.xls