данные переносятся по условию

[Радистка_Кет]

Подскажите пожалуйста как поменять код, что бы данные переносились по условию, если оно выполняется во всех файлах
в данном примере данные переносятся, если это верно хотя бы в одном файле

Код Выделить Развернуть

REM  *****  BASIC  *****

REM  Процедуры и функции этого модуля копируют
REM  уникальные данные с первых листов каждой из
REM  электронных книг в подкаталоге \2\
REM  относительно каталога текущей книги.
Sub InitMainSheet
Dim oSheets As Variant  ' Все листы текущей книги
Dim oSheet As Variant   ' Первый лист (с данными)
Dim oCurs As Variant    ' Курсор листа oSheet
Dim aRangeAddress As New com.sun.star.table.CellRangeAddress
Dim nEndColumn As Long  ' Номер последней заполненной колонки (нумерация с 0!)
Dim nEndRow As Long     ' Номер последней заполненной строки (нумерация тоже с 0!)
Dim oCellRange As Variant ' Диапазон ячеек A1:D5
    oSheets = ThisComponent.getSheets()
    oSheet = oSheets.getByIndex(0)
    oCurs = oSheet.createCursor()
    oCurs.gotoEndOfUsedArea(True)
    aRangeAddress = oCurs.getRangeAddress()
    nEndColumn = aRangeAddress.EndColumn
    nEndRow = aRangeAddress.EndRow
    If (nEndColumn < 4) Or (nEndRow < 3) Then
        oCellRange = oSheet.getCellRangeByName("A1:E4")
        oCellRange.setDataArray( Array)
    EndIf
End Sub

REM Функция пытается получить массив массивов данных
REM с листа oSheet. Если в листе меньше заполненных
REM строк, чем nTop, или меньше заполненных колонок,
REM чем (nLeft+countCol-1), то возвращает пустой массив.
REM Иначе возвращает массив Variant длиной "количество
REM считанных строк", каждый из элементов которого сам
REM является массивом Variant со значениями ячеек из
REM каждой из считанных строк.
Function getDataToArray(oSheet, nLeft As Long, nTop As Long, countCol As Long)
Dim oCurs As Variant    ' Курсор листа oSheet
Dim aRangeAddress As New com.sun.star.table.CellRangeAddress
Dim nEndColumn As Long  ' Номер последней заполненной колонки (нумерация с 0!)
Dim nEndRow As Long     ' Номер последней заполненной строки (нумерация тоже с 0!)
Dim oCellRange As Variant ' Диапазон ячеек A1:D5
    oCurs = oSheet.createCursor()
    oCurs.gotoEndOfUsedArea(True)
    aRangeAddress = oCurs.getRangeAddress()
    nEndColumn = aRangeAddress.EndColumn
    nEndRow = aRangeAddress.EndRow
    If (nEndColumn < (nLeft+countCol-1)) Or (nEndRow < nTop) Then
        getDataToArray = Array()
    Else
        getDataToArray = oSheet.getCellRangeByPosition(nLeft, nTop, (nLeft+countCol-1), nEndRow).getDataArray()
    EndIf
End Function

REM Главная процедура
REM Её задача считать уже существующие значения на
REM первом листе текущей книги в массив, дополнить
REM отсутствующими значениями с первых листов
REM всех книг в подкаталоге и записать обратно
Sub collectData
Dim oDoc As Variant     ' Текущаяя книга
Dim oSheets As Variant  ' Все листы текущей книги
Dim oSheet As Variant   ' Первый лист (с данными)
Dim mainArray()         ' Массив данных
Dim maxIndex As Long    ' Верхняя граница массива mainArray
Dim curIndex As Long    ' Последний заполненнный элемент массива mainArray
Dim I&, J&              ' Просто переменне для циклов
Dim wasNotOp As Boolean ' Обрабатываемый файл не был открыт
Dim iDoc As Variant     ' Файл с входными данными
Dim iSheet As Variant   ' Первый лист файла с входными данными
Dim iArray()            ' Входные данные
Dim tmpArr As Variant   ' Вспомогательный массив (строка входных данных)
Dim dirOfInputFiles As String   ' Имя каталога, в котором ищем файлы с данными
Dim allFNames As Variant    ' Массив всех найденных файлов
Dim args(0) As New com.sun.star.beans.PropertyValue
    args(0).name="Hidden"
    args(0).value=True
    oDoc = ThisComponent
REM Если текущий документ новый, нигде не сохраненный,
REM то и путь к подкаталогу получить не получится
    If Not oDoc.hasLocation Then Exit Sub
    If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then _
        GlobalScope.BasicLibraries.LoadLibrary("Tools")
REM И первым делом проверим тип текущего документа
REM с помощью функции Tools.GetDocumentType
REM Продолжим работу только если текущий документ книга Calc:
    If GetDocumentType(oDoc) <> "scalc" Then Exit Sub
REM Проверим заполненность шапки первого листа текущей книги:   
    InitMainSheet
REM Подготовительные действия окончены, приступаем к работе:
    oSheets = oDoc.getSheets()
    oSheet = oSheets.getByIndex(0)
    mainArray = getDataToArray(oSheet, 0, 4, 5)
    maxIndex = UBound(mainArray())
    curIndex = maxIndex
REM Имя подкаталога с книгами исходных данных:
    dirOfInputFiles = DirectoryNameOutOfPath(ConvertFromURL(oDoc.getURL()),"\") + "\2"
    If Not FileExists(dirOfInputFiles) Then
        MsgBox("Папка " & dirOfInputFiles & " не найдена")
        Exit Sub
    Else
    EndIf
    allFNames = ReadDirectories(dirOfInputFiles, True, False, False, Array("xls","ods","sxc"))
    If LBound(allFNames) > UBound(allFNames) Then
        MsgBox("В папке " & dirOfInputFiles & " нужных файлов не найдено")
        Exit Sub
    EndIf
    For I = LBound(allFNames) To UBound(allFNames)
        iDoc = OpenDocument(allFNames(I,0), args(), wasNotOp)
        iSheet = iDoc.getSheets().getByIndex(0)
        iArray = getDataToArray(iSheet, 0, 11,33)
        If wasNotOp Then DisposeDocument(iDoc)
        For J = LBound(iArray) To UBound(iArray)
            tmpArr = iArray(J)
            If tmpArr(24)>0 Then
            If GetIndexInMultiArray(mainArray, tmpArr(4), 1) < 0 And ((tmpArr(27)+ tmpArr(26))/tmpArr(24)*100)>15  Then
                curIndex = curIndex + 1
                If curIndex > maxIndex Then
                    maxIndex = maxIndex + 100 ' Чтобы пореже вызывать ReDim
                    Redim Preserve mainArray(MaxIndex)
                End If
                mainArray(curIndex) = Array(curIndex+1,tmpArr(4),tmpArr(3),tmpArr(32),8)
                End If
            End If
        Next J
    Next I
REM Все данные собраны в массиве mainArray.
    If curIndex > 0 Then
        If curIndex <> maxIndex Then Redim Preserve mainArray(curIndex)
REM Область для записи данных - пять колонок, curIndex строк (начиная с пятой)
        oSheet.getCellRangeByPosition(0, 4, 4, curIndex+4).setDataArray(mainArray)
    EndIf
End Sub
Function GetIndexInMultiArray(SearchList(), SearchValue, SearchIndex As Long) As Long
Dim i As Long
Dim MaxIndex As Long
Dim CurFieldValue
    MaxIndex = Ubound(SearchList(),1)
    For i = Lbound(SearchList()) to MaxIndex
        CurFieldValue = SearchList(i)(SearchIndex)
        If CurFieldValue = SearchValue Then
            GetIndexInMultiArray() = i
            Exit Function
        End if
    Next
    GetIndexInMultiArray() = -1
End Function

[Smaigas]

Замените OR на AND

[JohnSUN]

Слушай, Кэт, а ты не хочешь поступить чуть иначе? Собрать в листе текущей книги ВСЕ данные, не заморачиваясь дополнительными проверками в макросе, а уже потом отсортировать и отфильтровать полученную таблицу по нужным критериям?

[Радистка_Кет]

В каком месте поменять на OR?

мне казалось за это условие отвечает эта строчка:

Код Выделить Развернуть

If GetIndexInMultiArray(mainArray, tmpArr(4), 1) < 0 And ((tmpArr(27)+ tmpArr(26))/tmpArr(24)*100)>15  Then
и что там, что в функции менять нечего. или я ошибаюсь.


Мне хотелось всё таки предварительную проверку данных...

[JohnSUN]

Подскажите пожалуйста как поменять код, что бы данные переносились по условию, если оно выполняется во всех файлах

мне казалось за это условие отвечает эта строчка:

Код Выделить Развернуть

If GetIndexInMultiArray(mainArray, tmpArr(4), 1) < 0 And ((tmpArr(27)+ tmpArr(26))/tmpArr(24)*100)>15  Then
и что там, что в функции менять нечего. или я ошибаюсь.
Мне хотелось всё таки предварительную проверку данных...

Чтобы выполнить проверку на условие "выполняется во всех файлах", нужно считать все файлы. В лист книги или в массив в памяти - не имеет значения. Нужно прочитать всё.
А вот это условие, которое процитировано, на нормальный язык переводится как "человек до сих пор ни разу не встречался И что-то там из колонки AB плюс чего-то из колонки AA деленное на что-то там из колонки Y больше 0,15".
Получается, что если человек уже встречался в других книгах, то эта оценка >15 уже не имеет значения.
Это условие примеряется к одной единственной строке одного единственного листа (который ты почему-то читаешь с 12-ой строки, хотя до сих пор речь шла о чтении с 5-ой)... Затолкать СЮДА условие "во всех файлах" просто нет возможности...