5
Excel 2007.VBS - Zeilen löschen, deren Zellen mehr als 16 Zeichen, Sonderzeichen ausser . (Punkt) oder Leerzeichen haben
Hi,
ich hab mal wieder ein kleines Problem mit einer riesen Tabelle.
Die Tabelle besteht aus 4 Spalten und ist folgendesmassen aufgebaut
Vorname.Nachname | Vorname | Nachname | Passwort
Hat eine Zelle mehr als 16 Zeichen, ein Sonderzeichen ausser dem '.' (Punkt) oder ein Leerzeichen, soll die Zeile gelöscht werden. Super wäre natürlich noch, wenn ich zwischendrin keine Leerzeilen hätte.
Wenn irgendwer ne tolle Idee für ein VBSkript hat - ich beherrsche es leider nicht - würde es mich wirklich freuen, wenn er oder sie es mir posten könnte...sonst bin ich ein wenig aufgeschmisse :/
Vielen Dank
ich hab mal wieder ein kleines Problem mit einer riesen Tabelle.
Die Tabelle besteht aus 4 Spalten und ist folgendesmassen aufgebaut
Vorname.Nachname | Vorname | Nachname | Passwort
Hat eine Zelle mehr als 16 Zeichen, ein Sonderzeichen ausser dem '.' (Punkt) oder ein Leerzeichen, soll die Zeile gelöscht werden. Super wäre natürlich noch, wenn ich zwischendrin keine Leerzeilen hätte.
Wenn irgendwer ne tolle Idee für ein VBSkript hat - ich beherrsche es leider nicht - würde es mich wirklich freuen, wenn er oder sie es mir posten könnte...sonst bin ich ein wenig aufgeschmisse :/
Vielen Dank
Auf Facebook teilen
Auf Twitter teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 104079
Url: https://administrator.de/contentid/104079
Ausgedruckt am: 24.11.2024 um 14:11 Uhr
5 Kommentare
Neuester Kommentar
Moin Moin
Schau Dir das mal an (ungetestet). Die geprüften Sonderzeichen must du wohl noch wetwas erweitern und es wird zurzeit nur Spalte A geprüft.
Gruß L.
Schau Dir das mal an (ungetestet). Die geprüften Sonderzeichen must du wohl noch wetwas erweitern und es wird zurzeit nur Spalte A geprüft.
Const ExcelFile ="C:\Test.xls"
Const MaxZeilen = 1000
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(ExcelFile)
Set objWorkSheet = objWorkbook.Worksheets(1)
i = 1
While i < maxzeilen
szValue = objWorkSheet.Range("A" & i).Value
if szValue<>"" Then
szValue = Replace(szValue," ","")
If Len(szValue) > 16 then bFound = True
If Instr(szValue,"!") > 0 Then bFound = True
If Instr(szValue,"§") > 0 Then bFound = True
If Instr(szValue,"$") > 0 Then bFound = True
If Instr(szValue,"%") > 0 Then bFound = True
If Instr(szValue,"&") > 0 Then bFound = True
If Instr(szValue,"/") > 0 Then bFound = True
' ...
If bFound Then
objWorkSheet.Rows( i & ":" &i).delete
Else
objWorkSheet.Range("A" & i).Value = szValue
end if
end if
if Not bFound Then
i = i + 1
end if
szValue =""
bFound = False
Wend Gruß L.
Const ExcelFile ="C:\import.xlsx"
Const MaxZeilen = 65000
Const MaxSpalten = 4
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(ExcelFile)
Set objWorkSheet = objWorkbook.Worksheets(1)
j = 1
While j < MaxSpalten
i = 1
While i < MaxZeilen
szValue = objWorkSheet.Range(j & i).Value
if szValue <> "" Then
szValue = Replace(szValue," ","")
If Len(szValue) > 16 then bFound = True
If Instr(szValue,"!") > 0 Then bFound = True
If Instr(szValue,"§") > 0 Then bFound = True
If Instr(szValue,"$") > 0 Then bFound = True
If Instr(szValue,"%") > 0 Then bFound = True
If Instr(szValue,"&") > 0 Then bFound = True
If Instr(szValue,"/") > 0 Then bFound = True
' ...
If bFound Then
objWorkSheet.Rows( i & ":" &i).delete
Else
objWorkSheet.Range(j & i).Value = szValue
end if
end if
if Not bFound Then
i = i + 1
end if
if i == 65000 Then
j = j + 1
end if
szValue =""
bFound = False
EndIch versteh das Skript nicht so ganz, liegt warscheinlich aber auch daran, dass ich nicht programmieren kann
Moin
Also objWorkSheet.Range erwartet einen Textparameter in der Form C:2.
Des wegen wird das mit Deinem j hier nix.
Um so eine Zähler in Buchstaben umzurechen kann man Chr und Ascii verwenden,
etwa so:
Die Zeile
ist überflüssig, dafür haben wir While ... Wend schleifen.
Probiers mal so:
Gruß L.
Also objWorkSheet.Range erwartet einen Textparameter in der Form C:2.
Des wegen wird das mit Deinem j hier nix.
Um so eine Zähler in Buchstaben umzurechen kann man Chr und Ascii verwenden,
etwa so:
...
Spalte = chr(64 +j)
szValue = objWorkSheet.Range(Spalte & ":" & i).Value Die Zeile
if i == 65000 Then Probiers mal so:
Const ExcelFile ="C:\import.xlsx"
Const MaxZeilen = 65000
Const MaxSpalten = 4
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(ExcelFile)
Set objWorkSheet = objWorkbook.Worksheets(1)
j = 1
While j < MaxSpalten
i = 1
While i < MaxZeilen
Spalte = chr(64 +j)
szValue = objWorkSheet.Range(Spalte & ":" & i).Value
if szValue <> "" Then
szValue = Replace(szValue," ","")
If Len(szValue) > 16 then bFound = True
If Instr(szValue,"!") > 0 Then bFound = True
If Instr(szValue,"§") > 0 Then bFound = True
If Instr(szValue,"$") > 0 Then bFound = True
If Instr(szValue,"%") > 0 Then bFound = True
If Instr(szValue,"&") > 0 Then bFound = True
If Instr(szValue,"/") > 0 Then bFound = True
' ...
If bFound Then
objWorkSheet.Rows( i & ":" & i).delete
Else
objWorkSheet.Range(j & i).Value = szValue
end if
end if
if Not bFound Then
i = i + 1
end if
szValue =""
bFound = False
Wend
j = j + 1
Wend
objWorkbook.SaveAs ExcelFile
objExcel.Visible = True Gruß L.
Hallo FaBMiN und Logan000!
Als etwas schlankere Alternative (nur bezogen auf das Überprüfen der Zellen) böte sich etwas in der Art an (hier allerdings als VBA-Version):
Noch als Anmerkung: Anstelle von
(warum eigentlich ":" dazwischen?) sollte es auch
tun (wobei für die Angabe der Spalte sowohl eine Zahl als auch ein Buchstabe verwendet werden kann - siehe oben).
Grüße
bastla
Als etwas schlankere Alternative (nur bezogen auf das Überprüfen der Zellen) böte sich etwas in der Art an (hier allerdings als VBA-Version):
Set rE = CreateObject("VBScript.RegExp")
rE.Pattern = "[^\w\. ]|_" 'da "_" in "\w" enthalten ist, getrennt prüfen
BisSpalte = 4
MaxLen = 16
Z = 2 'erste zu überprüfende Zeile
Do While Cells(Z, "A").Value <> ""
For Sp = 1 To BisSpalte
Inhalt = Cells(Z, Sp).Value
If Len(Inhalt) > MaxLen Or rE.Test(Inhalt) Then
Rows(Z).Delete
Z = Z - 1 'Zähler korrigieren, da aktuelle Zeile entfernt wurde
Exit For
End If
Next
Z = Z + 1
LoopszValue = objWorkSheet.Range(Spalte & ":" & i).Value
szValue = objWorkSheet.Cells(i, j).Value
Grüße
bastla
Na sauber bastla...werde ich mir morgen gleich mal antun
ich hoffe es funktioniert.
Danke euch beiden auf jedenfall!
ich hoffe es funktioniert.
Danke euch beiden auf jedenfall!
