» Excel VBA (часть 3)

Помогите решить задачу!
Есть файл (txt) подобного вида:
[more]1CClientBankExchange
ВерсияФормата=1.01
Кодировка=Windows
Отправитель=PSB-Online
Получатель=ExternalProg
ДатаСоздания=13.10.2014
ВремяСоздания=00:00:00
ДатаНачала=15.09.2014
ДатаКонца=13.10.2014
РасчСчет=40702810402000009220
СекцияРасчСчет
ДатаНачала=15.09.2014
ДатаКонца=13.10.2014
РасчСчет=40702810402000009220
НачальныйОстаток=10736.17
ВсегоПоступило=929900.00
ВсегоСписано=935673.00
КонечныйОстаток=4963.17
КонецРасчСчет

СекцияДокумент=Платежное поручение
Номер=12
Дата=15.09.2014
Сумма=204200.00
НазначениеПлатежа=Оплата по счету №264 от 12,09,2014г. за материалы. В т.ч.НДС(18%) 31149-15.
Плательщик1=ООО Регион Торг"
ПлательщикИНН=4632162684
ПлательщикСчет=40702810481260008942
ПлательщикКПП=463201001
ПолучательКПП=463201001
ПоказательКБК=
ОКАТО=
ПоказательОснования=
ПоказательПериода=
ПоказательНомера=
ПоказательДаты=
ПоказательТипа=
ПлательщикБанк1=МОСКОВСКИЙ ФИЛИАЛ ОАО КБ "ВОСТОЧНЫЙ" г МОСКВА
ПлательщикБИК=044585682
ПлательщикКорсчет=30101810500000000682
Получатель1=ООО "Оптима Групп"
ПолучательИНН=4632162691
ПолучательСчет=40702810402000009220
ВидОплаты=01
СрокПлатежа=
Очередность=5
ВидПлатежа=Электронно
ДатаПоступило=15.09.2014
ПолучательБанк1=ЯРОСЛАВСКИЙ Ф-Л ОАО "ПРОМСВЯЗЬБАНК" г. ЯРОСЛАВЛЬ
ПолучательБИК=047888760
ПолучательКорсчет=30101810300000000760
КонецДокумента
[/more]

Т.е. в нем есть секции:
СекцияДокумент
…
КонецДокумента
Между ними имена полей и их значения.
Всего полей, как я понял, может быть 38:

[more]
1    Номер
2    Дата
3    Сумма
4    ДатаСписано
5    Плательщик
6    ПлательщикИНН
7    ПлательщикКПП
8    Плательщик1
9    ПлательщикСчет
10    ПлательщикРасчСчет
11    ПлательщикБанк1
12    ПлательщикБанк2
13    ПлательщикБИК
14    ПлательщикКорсчет
15    ДатаПоступило
16    Получатель
17    ПолучательИНН
18    ПолучательКПП
19    Получатель1
20    ПолучательСчет
21    ПолучательРасчСчет
22    ПолучательБанк1
23    ПолучательБанк2
24    ПолучательБИК
25    ПолучательКорсчет
26    ВидПлатежа
27    ВидОплаты
28    СтатусСоставителя
29    ПоказательКБК
30    ОКАТО
31    ПоказательОснования
32    ПоказательПериода
33    ПоказательНомера
34    ПоказательДаты
35    ПоказательТипа
36    СрокПлатежа
37    Очередность
38    НазначениеПлатежа
[/more]

Но в секции они могут отображаться не все (см. пример)

Задача.
Создать таблицу Excel
1-строка заголовки полей 38 (но желательно выборочно)
2-строка и т.д. значения полей (если поле отсутствует в секции, то значение = пусто)

Возможно ли?

Dem
Данные, текст по столбцам по "=" отлично справится с этой задачей.

Цитата:

Данные, текст по столбцам по "=" отлично справится с этой задачей.

как-то у меня не справляется (
И даже не представляю как он может справиться.
Вы правильно поняли задачу?
Должно быть 38 (либо выборочно, например 10) столбцов и кол-во строк, равное количеству секций.
Текст по столбцам делает всего 2 столбца и строки = строки в файле txt.
Или я чего-то упускаю по этой функции?

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

Fsp050


Цитата:

Цифра 20 тут встречается 9 раз  
суммируем первоначальные ранги этого значения (8+9+10+11+12+13+14+15+16=108) и делим на 9  =12 и всем двадцаткам присваиваем ранг 12

И чем это отличается от простого суммирования? 108/9*9=108 или 8+9+10+11+12+13+14+15+16=108


Цитата:

Сумма рангов  для группы 1
Сумма рангов  для группы 2
Ux
Uy

именно так и есть в последнем варианте:

Код:
.Cells(iLRw + 3, iCl).Value = lSum1
.Cells(iLRw + 4, iCl).Value = lSum2
.Cells(iLRw + 5, iCl).Formula = "=" & lNum1 & "*" & lNum2 & "-" & lSum1 & "+" & lNum1 & "*(" & lNum1 & "+1)/2" ' = 45*23-1394+45(45+1)/2=676
.Cells(iLRw + 6, iCl).Formula = "=" & lNum1 & "*" & lNum2 & "-" & lSum2 & "+" & lNum2 & "*(" & lNum2 & "+1)/2" ' = 45*23-952+23*(23+1)/2=359

Цитата:

Что мешает потом скопировать и вставить с траспонированием?

Наверное то, что секций, в принципе, неограниченное количество и количество полей (параметров) разное.
Всего их 38, но в секции могут быть не все!.
Мне казалось, что я подробно описал задачу.
Считать файл в переменную - это самое простое, что есть в задаче, а вот дальше...
Знал бы как - не спрашивал бы.

Файл имеет следующую структуру:
...
текст (шапка)
...
Секциядокумент(1)
параметр(1) = данные(1,1)
...
параметр(k) = данные(k,1)
Конец документа
...
...
...
Секциядокумент(n)
параметр(1) = данные(1,n)
...
параметр(k) = данные(k,n)
Конец документа

n = от 1 до неопределенно
k = от неопределенно до 38

все возможные "параметры k" я перечислил выше.

нужно получить таблицу
параметр 1 ... параметр 38

andrewkard1980

Цитата:

Цитата:
Сумма рангов  для группы 1  
Сумма рангов  для группы 2  
Ux  
Uy

 
именно так и есть в последнем варианте:

Код:
 
 .Cells(iLRw + 3, iCl).Value = lSum1  
            .Cells(iLRw + 4, iCl).Value = lSum2  
            .Cells(iLRw + 5, iCl).Formula = "=" & lNum1 & "*" & lNum2 & "-" & lSum1 & "+" & lNum1 & "*(" & lNum1 & "+1)/2" ' = 45*23-1394+45(45+1)/2=676  
            .Cells(iLRw + 6, iCl).Formula = "=" & lNum1 & "*" & lNum2 & "-" & lSum2 & "+" & lNum2 & "*(" & lNum2 & "+1)/2" ' = 45*23-952+23*(23+1)/2=359  
 

 :

Вы не поняли. выдается просто результат))

смотрите , когда макрос выполнился.
то с 78-81 результаты суммы рангов и этих умножений. а можно ли сделать, чтобы слева в ячейках в b78-81
отображились эти названия


Сумма рангов  для группы 1  
Сумма рангов  для группы 2  
Ux  
Uy

Добавлено:

Цитата:

Fsp050
 

Цитата:
Цифра 20 тут встречается 9 раз  
суммируем первоначальные ранги этого значения (8+9+10+11+12+13+14+15+16=108) и делим на 9  =12 и всем двадцаткам присваиваем ранг 12  

в том что в этом ряде чисел
1
2
3
4
10
11
12
20
20
20
20
20
20
20
20
20

после цифра 20 встречается больше 5 раз, ей ставят усредненный ранг
т.е. ранги идут не так
1
2
3
4
5
6
7

Код: 8
9
10
11
12
13
14
15
16
17

Dem
Не тестировал, +надо иметь шаблон Excel с названифми в первой строчке, попробуйте разобратся в коде и доработать под себя:

Код:
Sub TxtToExcel()
Dim aData()
Dim i%: i = 0
Dim l%
Dim lRw%: lRw = 0
Dim sNmFld$

oTxt = Application.GetOpenFilename("TXT Files(*.txt),*.txt", , , , True)
Open oTxt(1) For Input As #1
Do Until EOF(1)
Line Input #1, txt
ReDim Preserve aData(i)
aData(i) = txt
i = i + 1
Loop
Close #1

For i = 0 To UBound(aData)
If InStr(1, aData(i), "Секция") > 0 Then lRw = lRw + 1
For l = 1 To 38
sNmFld = Cells(1, l).Value
If InStr(1, aData(i), sNmFld) > 0 Then Cells(lRw, l) = Mid(aData(i), InStr(1, aData(i), "="))
Next l
Next i
End Sub

andrewkard1980
http://rghost.ru/58653382
вот тут повторил на базе Вашего примера
у Вас сумма с б2-б11=45, а не 55. А после преобразования уже становится действительно =55
взгляните.

Fsp050
У Вас ошибка, нет математической разницы между:
1+2+3=6
и

6/3=2 т.е. 2+2+2=6

andrewkard1980
согласен, не очень удачный пример.
давайте, пож-та рассмотрите этот
http://rghost.ru/58670007

Добавлено:
a2-a18 значения выборки
б2-б18 ранги ей и б19 сумма рангов =153
посколько тут 20 встречается 9 раз, усредним ей ранг, путем сложения т.о
=СУММ(C9:C18)/9
далее за место б9 -б18 ставим д9-д18
=166.
Надеюсь теперь Вы точно поняли;)

Fsp050
Пишете 9 раз, а ставите 10. По этому и разница:
http://rghost.ru/58670921

andrewkard1980
Может, пока Fsp050 думает что ему надо,Вы мне поможете. Вот тут я описывал свою ситуацию
http://forum.ru-board.com/topic.cgi?forum=5&topic=33123&start=2960
мне ответили

Цитата:

но в гуманитарных науках картина распределения не так часто симметрична и следовательно не совсем "стандартное", так что под распределение надо будет генерацию чисел подбирать , такое легче херез функцию на VBA написать (в другом разделе).

И вот в файле
http://rghost.ru/58652575
синим пометил имеющиеся 5 наблюдений по 47 переменным.
стал для каждой переменной вычислять доверительный интервал.
но почему то , начиная с 33 переменной доверительный интервал начинает пересекать ноль. просто в этой методике не бывает минусовых значений.

Futurism
Вы уверены, что не бывает? К топику это как-то относится? Конкретней вопрос задавайте. И желательно с учетом 1 абзаца шапки топика.

andrewkard1980
уверен на 101% в этой методике минусовых значений нет! Поверьте, пусть я и не программер, но свою отрасль знаю;)
У меня как бы 2 вопроса
1. я спросил в параллельном топике, если у меня есть доверительный интервал от 81-141, можно ли смоделировать ряд чисел?
Мне ответили
для плоского/ровного распределения: =RANDBETWEEN(84,141)
можно для стандартного что-то набросать, типа =INT(NORMINV(RAND(),(141+84)/2,(141-84)/6)) - некоторые значения могут выходить за диапазон (это 6 сигма границы), но в гуманитарных науках картина распределения не так часто симметрична и следовательно не совсем "стандартное", так что под распределение надо будет генерацию чисел подбирать , такое легче через функцию на VBA написать (в другом разделе).
Если я правильно понял надо под этот интервал сделать генерацию чисел несимметричного распределения

второй вопрос, по этому же файлу, но перефразирую,можно ли в ВБА реализовать метод монте-карло чтобы моделировать выборку, зная
1.только средние значения переменных
2. результаты для этих переменных выдаются как бы в 3х типах распределений: нормальном, пуассоновском, экспоненциальном. Т.е. на выходе 3 выборки , с разным распределением.

Futurism

Цитата:

уверен на 101% в этой методике минусовых значений нет!

не буду спорить, возможно отрицательные значения говорят о качестве выборки?
И если возможно, пример того, что Вы хотите, заниматься самообразованием в Вашей отрасли может и интересно, но времени нет.

Цитата:

не буду спорить, возможно отрицательные значения говорят о качестве выборки?

Наверное Вы правы. Собрать выборку не всегда есть возможность.

andrewkard1980, Примера у меня нет. =(( Вы знакомы с методом Монте-карло? Мне надо просто смоделировать выборку.
Например в маткаде, есть функция X: rnorm (n,m, сигма)
n=кол-во людей в выборке
m=среднее
сигма стандартное отклонение.
Мне надо смоделировать ответы на вопросы 100 людей по переменным X1-X100
среднее по каждой переменной я знаю.
Но сделать это надо с учетом нескольких распределений (нормальном, пуассоновском, экспоненциальном)

например, http://rghost.ru/58759746 тут даны средние. надо по ним смоделировать исходный ряд методом монте-карло, но по трем распределениям
1 лист это нормальное
2 лист это пуассоновское
3.экспоненциальное

Подскажите, пожалуйста, кодик, чтобы цифры, которые идут в одной ячейке через запятую, например в ячейке A1 1,2,3,4 встали в отдельные ячейки. b1=1, c1=2, d1=3, e1=4
для образца как тут
http://rghost.ru/58860643
а после того как цифры распределятся по своим ячейкам, можно ли сделать, чтобы на втором листе к каждой цифре было добавлено слово =бланк!b это число +15.
например =бланк!b1+15 =бланк!b16

можно ли провести такое добавление.
т.е. там вместо ссылка должно быть =бланк!b16

litmax
Текст по столбцам + ДВССЫЛ отлично справятся с данной задачей.
Если уж хочется макросом, тогда например так:

Код: Sub test()
Dim s$
Dim a$()
Dim i%

s = Cells(1, 1).Value
a = Split(s, ",")
For i = 1 To UBound(a)
Worksheets(2).Cells(1, i + 1).FormulaR1C1 = "=ЛИСТ3!R1C" & i + 15
Next
End Sub

andrewkard1980
Спасибо Вам, но что -то плохо работает. когда нажимаю выполнить макрос.
на втором листе появляется это

можете проверить.
http://rghost.ru/58875586
Как это исправить?

andrewkard1980
ну на 80%, это то) Ладно, вопрос закрыли)
А можете подсказать есть ли макрос для округления диапазона чисел
вот этого
http://rghost.ru/58876245
в смежней теме писал, но в ручную это долго.
надо числа округлять по такому принципу 3,4 округляем до 3, а 3,5 до 4х)

litmax
Это был пример, вот рабочий вариант:

Код:
Sub test()
Dim s$
Dim a$()
Dim i%

s = Cells(1, 1).Value
a = Split(s, ",")
For i = 1 To UBound(a)
Worksheets(2).Cells(1, i + 1).Formula = "=áëàíê!B" & a(i) + 15
Next
End Sub

andrewkard1980
теперь пишет ошибку 1004
в дебаге желтым выделена эта строчка.
Worksheets(2).Cells(1, i + 1).Formula = "=áëàíê!B" & a(i) + 15

Добавлено:
можете скинуть, пожалуйста, Ваш файл, где все работало. Может так проще будет.

Замените вот эту часть
"=áëàíê!B"

на

"=бланк!B"

andrewkard1980
Я кажется понял в чем проблема. Я неправильно Вам задачу объяснил.
давайте её разобьем на 2 части
1 часть. Можете сделать, чтобы вот эти числа которые через запятую в ячейке А1 , прописались по отдельным ячейкам
вот так?)


Добавлено:
с учетом, что потом ещё в А4 -А15 добавятся ряды чисел через запятую

litmax
Так?


Код:

Sub test()
Dim s$
Dim a$()
Dim i%, l%, iLr%
iLr = Cells(Rows.Count, 1).End(xlUp).Row

For l = 1 To iLr
s = Cells(l, 1).Value
s = Trim(Mid(s, InStr(1, Trim(s), " ")))
a = Split(s, ",")
For i = 0 To UBound(a)
Cells(l, i + 2).Value = a(i)
Worksheets(2).Cells(l, i + 2).Formula = "=blank!B" & Trim(a(i)) & "+ 15"
Next i
Next l
End Sub

litmax
Цитата:

...сделать, чтобы вот эти числа которые через запятую в ячейке А1 , прописались по отдельным ячейкам...

Можно проще:

Код: Sub qq()
[A1].CurrentRegion.TextToColumns Destination:=[B1], DataType:=xlDelimited, Comma:=True, Space:=True, FieldInfo:=Array(1, 9)
End Sub

andrewkard1980
SAS888
вот теперь в самый раз)))))

теперь вторая часть
на втором листе нужно чтобы он приплюсовал 15

видите, что он пишет #ССЫЛКА
можете сделать чтобы он к этому B1 прибавил 15 и стало B16))
=blank!B1+ 15 = blank!16

litmax
Странно он у Вас как то пишет, пробуйте:

Код:
Sub test()
Dim s$
Dim a$()
Dim i%, l%, iLr%
iLr = Cells(Rows.Count, 1).End(xlUp).Row

For l = 1 To iLr
s = Cells(l, 1).Value
s = Trim(Mid(s, InStr(1, Trim(s), " ")))
a = Split(s, ",")
For i = 0 To UBound(a)
Cells(l, i + 2).Value = a(i)
Worksheets(2).Cells(l, i + 2).Formula = "=blank!B" & Trim(a(i)) + 15
Next i
Next l
End Sub

andrewkard1980
все ок теперь)))))