Помощь с макросом

Автор Alder, 7 апреля 2016, 12:26

0 Пользователи и 1 гость просматривают эту тему.

Alder

Есть макрос.
Его задача просматривать большое кол-во числовых данных (в формате 0,00) и показывать что не является повтором.
Но появилась проблема, некоторые числа идут с погрешностью +/- 0,003.
Я бы хотел добавить строку:
oSelection = Round(oSearchResults.getByIndex(i),2)
Но oSelection у меня Variant.

Есть ли способ определения типа переменой и редактирование его?

Сам код, украл где-то:
Sub colorDbl
Dim oCurrentSelection As Variant
Dim oActiveSheet As Variant
Dim oSelection As Integer
Dim oDataArray As Variant
Dim oData As Variant
Dim oElement As Variant
Dim aCounter As Variant
Dim i&, j&, k&
Dim oSearchDescriptor As Variant
Dim oSearchResults As Variant
Dim sResult As String
Dim nCellBackColor As Long
oCurrentSelection = ThisComponent.getCurrentSelection()
If oCurrentSelection.supportsService("com.sun.star.table.Cell") Then ' Выделена только одна ячейка (то есть - ничего)
oActiveSheet = ThisComponent.getCurrentController().getActiveSheet()
oCurrentSelection = oActiveSheet.createCursor()
oCurrentSelection.gotoEndOfUsedArea(True)
EndIf
REM Чтобы не перебирать кучу пустых ячеек, выберем из выделения только непустые
oSearchDescriptor = oCurrentSelection.createSearchDescriptor()
oSearchDescriptor.SearchType = 1 ' Поиск по значениям
oSearchDescriptor.SearchRegularExpression = True
oSearchDescriptor.setSearchString(".+")
oSearchResults = oCurrentSelection.findAll(oSearchDescriptor)
aCounter = Array()
If IsEmpty(oSearchResults) Or IsNull(oSearchResults) Then
MsgBox("В указанном выделении нет ячеек для поиска дублей", 64, "Измените или снимите выделение")
Else
For i=0 To oSearchResults.getCount()-1
oSelection = oSearchResults.getByIndex(i)
oDataArray = oSelection.getDataArray()
For j = LBound(oDataArray) To UBound(oDataArray)
oData = oDataArray(j)
For k = LBound(oData) To UBound(oData)
oElement = oData(k)
If oElement <> "" Then CountOrAdd(oElement, aCounter)
Next k
Next j
Next i
REM Информация собрана, для всех повторов - раскраска
oSearchDescriptor = oCurrentSelection.createSearchDescriptor()
oSearchDescriptor.SearchType = 1 ' Поиск по значениям
oSearchDescriptor.SearchWords = True
j = 0
k = 0
sResult = ""
For i=LBound(aCounter) To UBound(aCounter)
oData = aCounter(i)
oSearchDescriptor.setSearchString(oData(0))
oSearchResults = oCurrentSelection.findAll(oSearchDescriptor)
If oData(1) > 1 Then
j = j + 1
If sResult <> "" Then sResult = sResult +", "
nCellBackColor = RGB(180,255,180)
sResult = sResult + oData(0)
k = k + oSearchResults.getCount()
Else
nCellBackColor = RGB(255,180,180)
EndIf
oSearchResults.CellBackColor = nCellBackColor
Next i
If j = 0 Then
MsgBox("В указанном выделении дублей не обнаружено", 64, "Без результата")
Else
EndIf
EndIf
End Sub

Private Sub CountOrAdd(key, aData)
Dim l&, r&, m&, N&, i&
l=LBound(aData)
r=UBound(aData)+1
N=r
While (l<r)
m=l+Int((r-l)/2)
If aData(m)(0)<key Then
l=m+1
Else
r=m
EndIf
Wend
If r=N Then
ReDim Preserve aData(0 To N)
aData(N) = Array(key,1)
ElseIf  aData(r)(0)=key Then
aData(r)(1)=aData(r)(1)+1
Else
ReDim Preserve aData(0 To N)
For i = N-1 To r Step -1
aData(i+1)=aData(i)
Next i
aData(r) = Array(key,1)
EndIf
End Sub


LO 4.3.5