Zahlen bedingt verschieben - VBA
07.06.2012 08:34:00
Erich
Hi Kurt,
die unter der Tabelle stehende Routine verteilt die Werte aus Spalte I (vorher aus Spalte G nach I kopiert) auf die Spalten I und K:
| | 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 | | |
Hier der Code:
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
Das Kriterium "Wert größer ist als 6 stellen" bzw. "Wert höher ist als z.B. 6 Stellig" ist nicht so recht klar.
Meinst du z. B. Wert > 999999?
Was ist dabei mit Nachkommastellen, Vorzeichen, Prozentzeichen?
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich