Страницы: 1 2 След.
RSS
QueryTable импорт формулы массива
 
Всем привет!
Прочитал статью: http://www.askit.ru/custom/vba_office/m11/11_07_excel_querytable_object.htm
Использую следующий код для использования импорта формул из текстового файла:
Код
Sub Макрос2()
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;D:\formula.txt", Destination:=Range("Bh2"))
        .Name = "formula"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1251
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierNone
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False 
    End With
End Sub

Но в статье нет информации, как обозначить, что формула является массивной?
И есть ли возможность транпортировать диапазон из вертикального в горизонтальный?
 
Доброе время суток.
Цитата
adamm написал:
как обозначить, что формула является массивной?
Никак, судя по многочисленным обсуждениям в том числе и на заграничных форумах, увы.
Чтобы не обрезало, поместите самую длинную формулу в первую строку. Далее, лучше читайте данные через Adodb.Recordset, потом для того самого транспонирования просто воспользуйтесь методом Recordset.GetRows, получая транспонированный массив, а уже его через метод Range.Resize помещайте как значения.
Updated
Хотя да, есть проблемы. Из простого
Код
Range("A1:B1").Value=array("=PI()", "=СЛЧИС()")
отрабатывает английская версия :(
Изменено: Андрей VG - 17.07.2019 23:02:11
 
Если формулы без ошибок, то можно так:
Код
Sub Test1()
  
  Const FileName = "D:\formula.txt"
  Const StartCell = "BH2"
 
  Dim FN As Integer, a As Variant, i As Long, s As String, txt As String

  If Dir(FileName) = "" Then
    MsgBox "File not found:" & vbLf & FileName, vbExclamation, "Exit"
    Exit Sub
  End If

  FN = FreeFile
  Open FileName For Input As #FN
  txt = Input(LOF(FN), #FN)
  Close #FN
  a = Split(txt, vbCrLf)
  
  For i = 0 To UBound(a)
    s = Trim(a(i))
    If Len(s) > 0 Then
      With Range(StartCell).Offset(, i)
        If Left(s, 1) = "{" Then
          .FormulaLocal = Mid(s, 2, Len(s) - 2)
          .FormulaArray = .Formula
        Else
          .FormulaLocal = s
        End If
      End With
    End If
  Next
  
End Sub
Изменено: ZVI - 18.07.2019 05:38:47
 
Добрый день! Метод QueryTables.Add при правильном использовании никаких обрезаний не делает.
Замените в #1 в строке 24 Array(1) на Array(2) (xlTextFormat).
Что касается примера Андрея из #2, то при присвоении свойства value ячейки Excel напрочь игнорирует региональные настройки. Это касается не только формул, но и чисел, дат, ...
Изменено: sokol92 - 18.07.2019 12:42:04
Владимир
 
ZVI, спасибо! Но формулы вставляются ни как массивные, только первая отрабатывает, остальные нет
Изменено: adamm - 22.07.2019 07:52:31
 
Цитата
ZVI написал:
Если формулы без ошибок
для массивной не длиннее 255 символов :-(
По вопросам из тем форума, личку не читаю.
 
Ну вот опять, вернулись к разбитому корыту(
 
adamm Я уже писал Вам в личке (переговоры в разделе работа) - сделайте шаблон и вставляйте как формулы. Если будут ссылки их можно перестроить.
Изменено: skais675 - 22.07.2019 09:18:07
 
Цитата
skais675 написал:
сделайте шаблон
В обоих случаях так и получается, что через PQ что через QueryTables, но в итоге проблема одна формулы массива не работают, то есть не вставляются {}. Или я, вас не правильно понял?  
 
adamm Напишите макрос, который будет просто копировать формулы из Вашего шаблона (должны быть работоспособные формулы) в Ваши файлы  (вставить как формулы). Единственная проблема может быть, если в формулах есть ссылки на соседние листы, но это тоже решается сменой ссылок. Все решается макросом.
Изменено: skais675 - 22.07.2019 14:24:32
 
Цитата
skais675 написал:
Единственная проблема может быть, если в формулах есть ссылки на соседние листы, но это тоже решается сменой ссылок. Все решается макросом.
Увы, коллега, тут есть ещё одна большая проблема - по условию, большая часть формул - это формулы массива, а ArrayFormula понимает только 255 символов. Тут питерский медвежатник пытался решить эту проблему.
 
Андрей VG Причем тут это? Так не будет работать?
Код
  Range("E5").Select
    Selection.Copy
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
Цитата
skais675 написал:
просто копировать формулы
Да я ведь так и делал, сопировал формулу, и вставил в формате R1C1, но так как длинна формулы более 255 знака код выдает ошибку
 
В результате, через PQ создаю запрос и подгружаю в каждую книгу формулы, а их в свою очередь тупо макросом копирую в нужные ячейки, формулу массива ввожу ручками
 
Цитата
adamm написал:
Да я ведь так и делал, сопировал формулу, и вставил в формате R1C1, но так как длинна формулы более 255 знака код выдает ошибку
Приведите простой пример где вы копируете с одного место в другое и у Вас не получается? Сделайте элементарный пример, а не такой как сейчас.
Одна формула - макрос на ее копирование и типа не получается.
 
adamm,1. Мне даже не проверить, и не попробовать с именами. Храните формулы в интернациональном формате.
2. Избавляйтесь от Select.

Для одной длинной сделал через имена
Код
Sub ttt()
Sheets("Основные линии").Range("BO3").Formula = Sheets("Справочно").Range("as9").Formula
On Error Resume Next
ThisWorkbook.Worksheets("Основные линии").Names("проблемы_РД_2_кл.").Delete
On Error GoTo 0
ThisWorkbook.Worksheets("Основные линии").Names.Add Name:="проблемы_РД_2_кл.", RefersToR1C1:=Sheets("Основные линии").Range("BO3").FormulaR1C1
Sheets("Основные линии").Range("Bo3").Formula = "=проблемы_РД_2_кл."
End Sub

В цикле перебрать то что нужно и обработать  - не проблема. На каждом листе свой набор имен, с формулой, которая ссылается на свой лист.
По вопросам из тем форума, личку не читаю.
 
БМВ, спасибо!
Сказать честно, с экселем работаю, как ни первый год, но про интернациональный формат не совсем понял, вы имели ввиду R1C1?
А по итогам, код работает, только в книгу подгружать формулы буду не через PQ, а через QueryTables хотя по сути одно и то же
 
Цитата
adamm написал:
но про интернациональный формат
англоязычные функции. Всегда можно посмотреть что у Вас в Formula. А вот FormulaLocal -это ваше привычное русскоязычное.

Что в результате работает? Через имена?
Изменено: БМВ - 22.07.2019 20:17:48
По вопросам из тем форума, личку не читаю.
 
БМВ,Ок, понял. Да работает через имена, спасибо!
 
Цитата
Андрей VG написал:
а ArrayFormula понимает только 255 символов.  Тут  питерский медвежатник пытался решить эту проблему.
Поможем подельнику товарищу. Написал не приходя в сознание в первом приближении монстроидальную функцию:
Код
' Sokol92 for PlanetaExcel
Option Explicit

' Присваивает диапазону rg формулу массива fArray
' @param rg диапазон
' @param fArray формула массива (должна начинаться на знак равенства)
' @return True при успехе; False при неудаче
Public Function LetFormulaArray(ByVal rg As Range, ByVal fArray As String) As Boolean
    If Left(fArray, 1) <> "=" Then Exit Function
      
    LetFormulaArray = FormulaArray(rg, fArray, 1)
    
    If LetFormulaArray Then  ' самопроверка
        If Not rg.Cells(1, 1).HasArray Or StrComp(rg.Cells(1, 1).Formula, fArray, vbTextCompare) <> 0 Then
            MsgBox "Error in function LetFormulaArray. Range address " & rg.Address(external:=True), vbCritical
            LetFormulaArray = False
        End If
    End If
End Function

' Присваивает диапазону rg формулу массива fArray
' @param level уровень вложенности вызова
' @param placeHolder префикс для замещающего текста
' @return True при успехе; False при неудаче
Private Function FormulaArray(ByVal rg As Range, ByVal fArray As String, ByVal level As Long, Optional ByVal placeHolder As String = "") As Boolean
    Dim arr_p(0 To 999) As Long  ' позиции круглых скобок по уровням вложенности в формуле
    Dim ind_p As Long            ' индекс в arr_p
    
    Dim what_beg As Long                ' позиция первого символа для замены на PlaceHolder
    Dim what_len As Long                ' длина заменяемого текста
    Dim what As String, repl As String  ' заменяемый текст и замещающий текст
    Dim n As Long, retval As Boolean
    Dim stat As Long ' Состояние "машины Тьюринга": 1-текст в двойных кавычках, 2-текст в апострофах, 0-прочие
    Dim i As Long, c As String
  
    If placeHolder = "" Then
        For i = 1040 To 1071 ' заглавные русские буквы
            c = ChrW(i) & "__"
            If InStr(1, fArray, c, vbTextCompare) = 0 Then
                placeHolder = c
                Exit For
            End If
        Next i
        
        If placeHolder = "" Then  ' все сочетания есть в формуле
            Exit Function
        End If
    End If
  
    If Len(fArray) <= 255 Then
        On Error Resume Next
        rg.FormulaArray = fArray
        FormulaArray = (Err.Number = 0)
        On Error GoTo 0
        If FormulaArray Or Len(fArray) <= 200 Then
          Exit Function
        End If
    End If
  
    If level >= 100 Then
        Exit Function
    End If
  
    ' ищем самый длинный фрагмент для замены на placeHolder
    arr_p(0) = 1
    i = 2
    Do While i <= Len(fArray)
        c = Mid(fArray, i, 1)
        
        If c = """" Then
            If stat = 0 Then
                stat = 1
            ElseIf stat = 1 Then
                If Mid(fArray, i + 1, 1) <> c Then stat = 0 ' не задвоенная двойная кавычка
            End If
            
        ElseIf c = "'" Then
            If stat = 0 Then
                stat = 2
            ElseIf stat = 2 Then
                stat = 0
            End If
        
        ElseIf c = "(" And stat = 0 Then
            ind_p = ind_p + 1
            arr_p(ind_p) = i
          
        ElseIf c Like "[),+/*-]" And stat = 0 Then ' возможный символ после замены
            n = i - arr_p(ind_p) - 1  ' число символов для замены
            If n > 10 And n <= 255 And n > what_len Then
                what_len = n
                what_beg = arr_p(ind_p) + 1
            End If
            If c = ")" Then
                If ind_p > 0 Then
                    ind_p = ind_p - 1
                End If
            End If
          
        End If
        i = i + 1
    Loop
    
    If what_len = 0 Then
        Exit Function
    End If
    
    ' меняем фрагмент
    repl = placeHolder & Format(level, "00")
    
    If what_beg >= 3 Then   ' после открывающей скобки
        c = Mid(fArray, what_beg - 2, 1)  ' символ перед скобкой
        If LCase(c) <> UCase(c) Or c Like "0-9_." Then
            what_beg = what_beg - 1
            what_len = what_len + 1
            what = Mid(fArray, what_beg, what_len)
            repl = placeHolder & "(" & repl
        End If
    End If
     
    If what = "" Then what = Mid(fArray, what_beg, what_len)
     
    retval = FormulaArray(rg, Left(fArray, what_beg - 1) & repl & Mid(fArray, what_beg + what_len), level + 1, placeHolder)
    If retval Then
        On Error Resume Next
        FormulaArray = rg.Replace(repl, what)
        On Error GoTo 0
    End If
    
End Function

Изменено: sokol92 - 23.07.2019 13:19:49
Владимир
 
sokol92, не ожидал, спасибо большое, а можете уточнить как работает функция, не совсем понял параметр rg диапазон, который присваивает формулу массива. Параметр fArray это ссылка на ячейку в которой находиться формула массива, return выводит лож или истину?
 
sokol92, Владимир, приветствую, ну как Вы знаете если код больше 10 строк, то это не Медвежье дело :-) У меня жесткий лимит :-).  О разборе строки думал, но прогнал мысль по причине того что если есть вероятность сбоя, то лучше сразу использовать иной метод, чем городить.  Проверять не проверял, но уверен, что  работает.
Изменено: БМВ - 23.07.2019 12:15:43
По вопросам из тем форума, личку не читаю.
 
Эта "жуткая" функция заменяет одну строку:
Код
rg.FormulaArray=fArray
Попробуйте, например, в примере Владимира (#3) заменить строку 25 на
Код
LetFormulaArray Range(StartCell).Offset(, i), .Formula

Не забудьте в Formula.txt взять в фигурные скобки формулы массива.
Параметры функции описаны в начале: rg - диапазон, fArray - текст формулы массива. Функция при успехе возвращает True, при неудаче - False.
Владимир
 
Здравствуйте, Михаил! Сбои могут быть (как и практически в любой программе "более, чем из 10 строк"). Специально, как учат в школе, добавил очевидную проверку в конце работы. Так что если функция вернула True, то это правда :)  Проверял, разумеется, на Ваших функциях.
Изменено: sokol92 - 23.07.2019 12:28:24
Владимир
 
sokol92,  Владимир, я про сбои не в количестве строк кода, а в логике формул
попробовал на этой
сразу сбой, не переварило принудительного перевода строки, не знаю как другие, но я часто пользуюсь при таких формулах, отделяя блоки для наглядности.

Мне кажется код Владимира достоин для размещения в копилке.
Изменено: БМВ - 23.07.2019 12:34:37
По вопросам из тем форума, личку не читаю.
 
Спасибо. Причина ошибки - присвоение свойству FormulaArray текста длины 246 символов (включая переводы строк). По документации максимум - 255. Сейчас постарался обойти эту ошибку.

Логика работы функции проста. Находим самый длинный "заменяемый" текст (но не длиннее 255 символов) после открывающей круглой скобки, заменяем текст на "заполнители" типа А__01 (02,...) и  рекурсивно повторяем. После того, когда формула "впишется" в свойство Range.FormulaArray, делаем с помощью метода Range.Replace обратные замены. Единственная "тонкость" - Excel знает сигнатуры своих функций (в частности, число параметров), так что к имени функции тоже приходится добавлять суффикс типа А__ (до открывающей круглой скобки).
Изменено: sokol92 - 23.07.2019 13:46:50
Владимир
 
Гуру VBA, с большим сожалением, ну ни как не могу сообразить как работает данная функция, перечитал десять раз тему, перепробовал разные варианты.
param rg диапазон - что за диапазон?
param fArray формула массива (должна начинаться на знак равенства) - это ссылка на ячейку или нужно подставить формулу?
return True при успехе; False при неудаче - то же не совсем понятно?

Ну уж простите меня, но код для меня это, пока темный лес
 
У вас нет желания ответить на #15?
 
LetFormulaArray(Куда вставлять, Текст что вставлять с = и без {} )
По вопросам из тем форума, личку не читаю.
 
Упростил пример
Страницы: 1 2 След.
Наверх