Но в статье нет информации, как обозначить, что формула является массивной? И есть ли возможность транпортировать диапазон из вертикального в горизонтальный?
adamm написал: как обозначить, что формула является массивной?
Никак, судя по многочисленным обсуждениям в том числе и на заграничных форумах, увы. Чтобы не обрезало, поместите самую длинную формулу в первую строку. Далее, лучше читайте данные через Adodb.Recordset, потом для того самого транспонирования просто воспользуйтесь методом Recordset.GetRows, получая транспонированный массив, а уже его через метод Range.Resize помещайте как значения. Updated Хотя да, есть проблемы. Из простого
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
Добрый день! Метод QueryTables.Add при правильном использовании никаких обрезаний не делает. Замените в #1 в строке 24 Array(1) на Array(2) (xlTextFormat). Что касается примера Андрея из #2, то при присвоении свойства value ячейки Excel напрочь игнорирует региональные настройки. Это касается не только формул, но и чисел, дат, ...
В обоих случаях так и получается, что через PQ что через QueryTables, но в итоге проблема одна формулы массива не работают, то есть не вставляются {}. Или я, вас не правильно понял?
adamm Напишите макрос, который будет просто копировать формулы из Вашего шаблона (должны быть работоспособные формулы) в Ваши файлы (вставить как формулы). Единственная проблема может быть, если в формулах есть ссылки на соседние листы, но это тоже решается сменой ссылок. Все решается макросом.
skais675 написал: Единственная проблема может быть, если в формулах есть ссылки на соседние листы, но это тоже решается сменой ссылок. Все решается макросом.
Увы, коллега, тут есть ещё одна большая проблема - по условию, большая часть формул - это формулы массива, а ArrayFormula понимает только 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 хотя по сути одно и то же
Андрей 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, не ожидал, спасибо большое, а можете уточнить как работает функция, не совсем понял параметр rg диапазон, который присваивает формулу массива. Параметр fArray это ссылка на ячейку в которой находиться формула массива, return выводит лож или истину?
sokol92, Владимир, приветствую, ну как Вы знаете если код больше 10 строк, то это не Медвежье дело :-) У меня жесткий лимит :-). О разборе строки думал, но прогнал мысль по причине того что если есть вероятность сбоя, то лучше сразу использовать иной метод, чем городить. Проверять не проверял, но уверен, что работает.
Не забудьте в Formula.txt взять в фигурные скобки формулы массива. Параметры функции описаны в начале: rg - диапазон, fArray - текст формулы массива. Функция при успехе возвращает True, при неудаче - False.
Здравствуйте, Михаил! Сбои могут быть (как и практически в любой программе "более, чем из 10 строк"). Специально, как учат в школе, добавил очевидную проверку в конце работы. Так что если функция вернула True, то это правда Проверял, разумеется, на Ваших функциях.
sokol92, Владимир, я про сбои не в количестве строк кода, а в логике формул попробовал на этой сразу сбой, не переварило принудительного перевода строки, не знаю как другие, но я часто пользуюсь при таких формулах, отделяя блоки для наглядности.
Мне кажется код Владимира достоин для размещения в копилке.
Спасибо. Причина ошибки - присвоение свойству FormulaArray текста длины 246 символов (включая переводы строк). По документации максимум - 255. Сейчас постарался обойти эту ошибку.
Логика работы функции проста. Находим самый длинный "заменяемый" текст (но не длиннее 255 символов) после открывающей круглой скобки, заменяем текст на "заполнители" типа А__01 (02,...) и рекурсивно повторяем. После того, когда формула "впишется" в свойство Range.FormulaArray, делаем с помощью метода Range.Replace обратные замены. Единственная "тонкость" - Excel знает сигнатуры своих функций (в частности, число параметров), так что к имени функции тоже приходится добавлять суффикс типа А__ (до открывающей круглой скобки).
Гуру VBA, с большим сожалением, ну ни как не могу сообразить как работает данная функция, перечитал десять раз тему, перепробовал разные варианты. param rg диапазон - что за диапазон? param fArray формула массива (должна начинаться на знак равенства) - это ссылка на ячейку или нужно подставить формулу? return True при успехе; False при неудаче - то же не совсем понятно?
Ну уж простите меня, но код для меня это, пока темный лес