Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

19 Июль 2019, 06:55 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Вы можете задать вопрос по LibreOffice или Apache OpenOffice  без регистрации, используя форму
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1   Вниз
  Печать  
Автор Тема: Помощь с макросом  (Прочитано 1356 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Alder
Участник
**
Offline Offline

Сообщений: 24


« Стартовое сообщение: 7 Апрель 2016, 12:26 »

Есть макрос.
Его задача просматривать большое кол-во числовых данных (в формате 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
« Последнее редактирование: 7 Апрель 2016, 12:28 от Alder » Записан
Страниц: 1   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2009, Simple Machines Valid XHTML 1.0! Valid CSS!