Delet Row funktioniert nicht
26.05.2014 19:17:30
Carmen
ich habe eine Mac und habe in einer Spalte Daten, die sich aus irgendeinem Grund nicht absteigen oder aufsteigend oder älter als 4 Monate oder sonst was sortieren lassen, im Windows Rechner funktioniert das komischerweise.
Ich habe es auch schon mit sämtlichen Feldformatierungen versucht - ohne Erfolg.
Deswegen habe ich einen Arbeitskollegen gebeten mir ein Makros zu programmieren, das Reihen, die älter sind als x Monate (gibt man in einem extra Feld ein) geköscht werden.
Das dumme ist auf dem Windows Rechner läuft das ohne Probelem aber auf meinem Mac nicht.
Mein Kollege weiss auch keinen Rat und ich habe davon eh keine Ahnung.
Darum bitte ich hier um Hilfe.
Das bisherige Makros sieht so aus
Dim rowOut As Integer
Sub main()
Dim str$, strNew$, row%, i%
Dim nextLoop As Boolean
ScreenUpdating = False
nextLoop = False
row = 9 'start row
Range("D9:D20000").Select 'selected cells
rowOut = 2 'start output row
str = Range("D" & row).Value
strNew = str
Worksheets(2).UsedRange.ClearContents
Sheets("Sheet1").Activate
For Each cell In Selection.SpecialCells(xlCellTypeVisible)
strNew = cell.Value
If strNew = "" Then Exit For
Do While strNew ""
i = InStr(strNew, " ")
'last word in string
If i = 0 Then
Call writeData(strNew)
Exit Do
End If
Call writeData(Left(strNew, i - 1))
strNew = Right(strNew, Len(strNew) - i)
Trim (strNew)
Loop
Next cell
ScreenUpdating = True
Worksheets("Output").Activate
End Sub
Private Sub writeData(str As String)
Dim cell As Range
Dim val%
With Worksheets("Output")
Set cell = .Range("A:A").Find(str, lookat:=xlWhole)
If cell Is Nothing Then 'new word
.Range("A" & rowOut).Value = str
val = .Range("B" & rowOut).Value
val = val + 1
.Range("B" & rowOut).Value = CStr(val)
rowOut = rowOut + 1
Else 'existing word, inc count
val = .Range("B" & cell.row).Value
val = val + 1
.Range("B" & cell.row).Value = val
End If
End With
End Sub
Private Sub DeleteRows_Click()
Dim month%
ScreenUpdating = False
month = Range("I2").Value
For i = 9 To UsedRange.Rows.Count
If month 0 And DateDiff("m", Range("AO" & i).Value, Date) > month Then
Rows(i).EntireRow.Delete
End If
Next i
ScreenUpdating = True
End Sub
Private Sub Run_Click()
Call main
End Sub
Es gibt ncoh ein Zweites mit Wörter zählen, das funktionuert einwandfrei.
Ich habe auch noch die dazugehörige Excel Liste hochgeladen, um ggf rückfragen vorzubeugen, die ich wahrscheinlich eh nict beantworten könnte.
Diese findet ihr hier https://www.herber.de/bbs/user/90851.xlsm
Ich möchte mich schon im Voraus ganz herzlich bei meinem Retter bedanken.
Gerne kann ich mich auch mit einer Keywrodrecherche für eine Webseite bedanken,
Herzlichst Camren Lehner
Anzeige