Mac VBA
29.04.2014 21:23:42
Carmen
ich abe ein VBA von einem Kollegen erhalnte das fua einem Windows erstellt wurde und das nciht auf meinem Mac läuft.
Wer kann mir das anpassen so dass es auch auf dem Mac läuft?
das hier ist sie:
Dim rowOut As Integer
Sub main()
Dim str$, strNew$, row%, i%
Dim nextLoop As Boolean
ScreenUpdating = False
nextLoop = False
row = 9 'start row
ActiveSheet.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
ActiveSheet.Range("A1:B1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.AutoFilter
ActiveSheet.Range("A1").Select
ActiveCell.FormulaR1C1 = "Keyword"
ActiveSheet.Range("B1").Select
ActiveCell.FormulaR1C1 = "Anzahl"
End Sub
Private Sub writeData(str As String)
Dim cell As Range
Dim val%
With Worksheets("Output")
Set cell = .Range("A:A").Find(str, after:=Cells(2, 1), 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 Run_Click()
Call main
End Sub