» Excel VBA (часть 3)

Цитата:

А Вам то это зачем?

для работы с большим кол-вом исследований.

Цитата:

Ладно, вопрос по алгоритму, берем первый столбик, sex, это y, второй sc, это х, высчитываем

нет, это номинативный переменные. Sex-это пол Sc это номер школы. они могут быть зависимыми, но это будет не регрессия, а дискриминантный анализ.
Но независимыми, они быть не могут нигде, когда речь о линейной регрессии идет
Но в целом вы идею поняли.


Цитата:

я так понял, Вам нужно знать с какими переменными R2 для конкретного Y будет максимальный, и это могут быть любые из представленных.

да, т.е. надо найти эти Y . сегодня Y цели, завтра конфрантационный копинг Ну, это утрировано.
Просто как я написал, я могу это вручную делать, варьировать местами зависимые и независимые переменные, какие-то удалять, а какие-то добавлять, но даже для моего примера, где мало данных, на этой уйдет дня 3.
А у нас может быть и 200 наблюдений по 50 переменных. Комментарии излишне.

Fsp050
Попробуйте, может чем то поможет:

Код:
Sub GetMaxR2()
Dim y%, x1%, x2%, l%, i%, iMin%, iMax%, v
y = 3 ' Столбик с переменной Y

If ThisWorkbook.Worksheets.Count < 2 Then
ThisWorkbook.Worksheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
Worksheets(1).Activate
End If

iMin = 4 ' Начало переменных Х
iMax = Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column ' Конец переменных Х

Do Until l = 100 ' К-во найденных вариантов R > 0.5
x1 = Int((iMax - iMin + 1) * Rnd + iMin)
x2 = Int((iMax - iMin + 1) * Rnd + iMin)
If x2 < x1 Then x2 = x1 + 1
Range("AX2:AX4").Select
Selection.FormulaArray = "=LINEST(R2C" & y & ":R39C" & y & ",R2C" & x1 & ":R39C" & x2 & ",1,1)"
With Worksheets(2)
v = Worksheets(1).Range("AX4").Value
If IsNumeric(v) = True Then
If v > 0.5 Then
i = .Cells(Rows.Count, "A").End(xlUp).Row
.Cells(i + 1, 1) = Worksheets(1).Range("AX4").Value
.Cells(i + 1, 2) = " " & x1 & " - " & x2
.Cells(i + 1, 3) = Cells(1, y).Value
l = l + 1
End If
End If
End With
Loop
End Sub

andrewkard1980
так сработало
но уточните

т.е. когда зависимая переменная цели, а независимые переменные идут с 6-22, то наш r2 равен 0,85, я правильно понял.

Если да, то Вы суперпрофи. Но такой вопрос, давайте теперь зависимой переменной будет "Процесс", и опять погнали по остальным независимым переменным , куда уже будет входить "цели".

Fsp050

Цитата:

а независимые переменные идут с 6-22, то наш r2 равен 0,85, я правильно понял

по крайней мере так говорит функция ЛИНЕЙН, а она не ошибается


Цитата:

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

меняйте их местами и вперед:
как то так:
...
http://higgs.rghost.ru/57690259/image.png

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

Цитата:

наш r2 равен 0,85,

вообще то там был и 1.00000

Добавлено:

Цитата:

можно ли сделать, так, чтобы они автоматически менялись местами

думаю можно

andrewkard1980
Можеж подсказать если возможность реализовать запуск формы без отображения екселя, чтоб свернут был при отображении формы.

andrewkard1980
поможете?
1 это крайнее значение р квадрата, что говорит, о том, что в модели переменная цели оказалась в независимых и пытается предсказать сама себя, но эта неточность для меня не критична. главное все работает, единственное, хотелось бы, чтобы не вручную столюцы менять. Цели отработала свой цикл, пошла другая. и так пока не наступить конечная переменная)

Fsp050
Нет, 100% она не участвовала в независимых, там же макрос так настроен, что работает с 4 столбца, а она стоит в 3. Столбцы можно так же менять рандомно. Просто до конца я так и не понял где же наша цель ) Перебор для перебора...

gogaman
На форуме здесь где то я встречал. Поищите. Либо на vb6 можно написать, очень похожий к VBA (или наоборот)

Цитата:

Fsp050
Нет, 100% она не участвовала в независимых, там же макрос так настроен, что работает с 4 столбца, а она стоит в 3. Столбцы можно так же менять рандомно. Просто до конца я так и не понял где же наша цель ) Перебор для перебора...

Цель так просто объяснить нельзя, потом с этими р-тами будет качественный анализ

пока как вы сказали перебор для перебора.
Буду благодарен, если сделаете ,чтобы после того как переменная себя в роли зависимой отработала сама вставала другая на её место

Fsp050


Цитата:

переменная себя в роли зависимой отработала

как посчитать это событие? Перебрать все варианты наверное по времени очень долго будет. А если еще и мешать столбики, то вообще.

andrewkard1980
да пускай долго будет. Я никуда не тороплюсь.

Fsp050

Пробуйте, обратите внимание на комментарии, можно ограничить глубину поиска:


Код:
Sub GetMaxR2()
Dim y%, x1%, x2%, l%, i%, iMin%, iMax%, v, k%, a(), b(), c, lLr%, g%
y = 3

Application.ScreenUpdating = False
If ThisWorkbook.Worksheets.Count < 2 Then
ThisWorkbook.Worksheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
Worksheets(1).Activate
End If

iMin = 4
iMax = Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
lLr = Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row

For k = 3 To iMax - 1
l = 0: g = 0
Do Until l = 1 ' количество найденных R2 для одной переменной
DoEvents
x1 = Int((iMax - iMin + 1) * Rnd + iMin)
x2 = Int((iMax - iMin + 1) * Rnd + iMin)
If x2 < x1 Then x2 = x1 + 1
c = Worksheets(1).Range(Cells(1, x1), Cells(1, x2))
Range("AX2:AX4").Select
Selection.FormulaArray = "=LINEST(R2C" & y & ":R" & lLr & "C" & y & ",R2C" & x1 & ":R" & lLr & "C" & x2 & ",1,1)"
With Worksheets(2)
v = Worksheets(1).Range("AX4").Value
If IsNumeric(v) = True Then
If v > 0.5 Then
i = .Cells(Rows.Count, "A").End(xlUp).Row
.Cells(i + 1, 1) = Worksheets(1).Range("AX4").Value
.Cells(i + 1, 2) = " " & x1 & " - " & x2
.Cells(i + 1, 3) = Worksheets(1).Cells(1, y).Value
.Range(.Cells(i + 1, 5), .Cells(i + 1, x2 - x1 + 5)) = c
l = l + 1
End If
End If
End With
g = g + 1
If g = 10 Then Exit Do ' количество итераций
Loop
ThisWorkbook.Save
With Worksheets(1)
a = Application.Transpose(.Range(.Cells(1, 3), .Cells(lLr, 3)))
b = Application.Transpose(.Range(.Cells(1, k + 1), .Cells(lLr, k + 1)))
.Range(.Cells(1, 3), .Cells(lLr, 3)) = Application.Transpose(b)
.Range(.Cells(1, k + 1), .Cells(lLr, k + 1)) = Application.Transpose(a)
End With
Next k
Application.ScreenUpdating = True
End Sub

подскажите, пожалуйста, решение задачки:
на одном листе есть данные следующего вида (2 столбца):
Информационные технологии Инф. техн.
История мировой культуры ИМК
Основы безопасности жизнедеятельности ОБЖ

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

Список создаю, используя опции Имя... - Присвоить... и Проверка данных (тип данных - список).

andrewkard1980
как всегда прекрасная работа. Извините, что не сразу ответил. Был не дома
а будет работать на большем объеме переменных. Сейчас, когда этот проект закрою, там будет штук 200 таких "целей")

Fsp050
Должно. Пробуйте, если что не так, отпишитесь.

Добавлено:
Alexey87
Можно формулами, пример:
=ИНДЕКС(Лист1!B1:B3;ПОИСКПОЗ(Лист2!A1;list;0);1)

http://rghost.ru/57801253

andrewkard1980
Вас понял, если будут вопросы Вам напишу.
Пока давно хотел Вас попросить поправить. помните вы делали мне макрос по хи-квадрату пирсона
http://forum.ru-board.com/topic.cgi?forum=33&topic=10903&start=3460

Есть ли возможность сделать так, чтобы текст не съезжался
например скрин


ячейка 9.
адаптация к новой физ.форме 1 и 2
там данные съезжают после конвертирования rtf-xls
9,1,10 должно быть под единичкой, а 52,0, 52 под двойкой
или 26 ячейка, под нулем должно быть 28 0 28 , а под единицей 16 0 16
если потеряли. вот сам файл
http://rghost.ru/57802472

0,1,2 это номинативные переменные. 0-может означать нет, а 1-да
но для ориентира эксель должен видеть, что в ячейке f26 и h26 стоят 0 и 1, и они стоят в
ячейке a27-28
походу после конвертирования смешение для каждой номинативной переменной идет на 1 столбец

andrewkard1980

Цитата:

ввод в эту же ячейку значения 2-го столбца 1-го листа

т.е. ввод сокращенного названия в ту же ячейку, где и список

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

Alexey87
Можно пример?

Цитата:

Можно пример?

http://qclk.ru/kk/c1zc

на первом листе в ячейке а1 должны отображаться сокращенные названия (т.е. данные столбца В второго листа)

Alexey87

В модуль листа с выпадающим списком:


Код:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim l
If Target.Cells.Count <> 1 Then Exit Sub
Select Case Target.Address(False, False)
Case "A1"
With Worksheets(2)
l = Application.Match(Target.Value, .[A:A], 0)
If IsNumeric(l) = True Then Range("A1") = .Cells(l, 2)
End With
End Select
End Sub

andrewkard1980
на безрыбье и рак рыба. хоть что-то уже хорошо

Такой вопрос.
Есть сторонняя программа Alpari Limited MT4, которую поправили так, что она запускает файл xlsm и с ним взаимодействует.
Проблема в том, что при таком запуске не срабатывает макрос автозапуска на VBA. При запуске вручную проблем нет.
Нет ли в настройках Excel каких то секретных галочек, которые на это могут повлиять?
В какую сторону хоть мне рыть...

andrewkard1980, а как будет выглядеть код для диапозона ячеек со списками - c5:d70 ?

Alexey87
Если имеется ввиду, что в ячейках C5:C70 полные наименования, а в ячейках D5:D70 сокращенные, то так:


Код:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim l
If Target.Cells.Count <> 1 Then Exit Sub
Select Case Target.Address(False, False)
Case "A1"
With Worksheets(2)
l = Application.Match(Target.Value, .[C5:C70], 0)
If IsNumeric(l) = True Then Range("A1") = .[C5:C70].Cells(l, 2)
End With
End Select
End Sub

Друзья, может мне сможет кто-то помочь в этой сложной задаче.
Есть файл
http://rusfolder.com/41632329
в столбце А3 есть фраза восстановление данных юго западная это ключевой запрос в поисковую систему.
а в столбце D3 по D52 снипеты. Снипет наверное знаете, когда ввели запрос яндекс выдает немного описания
ну вот пример

смотрим столбец
А 53 другой запрос
удаление вирусов пролетарская и к нему тоже снипеты.с D53 по d102
и так с каждым из запросов их тут мириады.
например этот запрос может быть встречен в снипетах, запроса, который где-то в экселе на 200 000 строке.
задача такая, что надо создать лист с попарными запросами. Например, чтобы эксель посмотрел встречается ли запрос восстановление данных юго западная в снипетах запроса удаление вирусов пролетарская
если да, то надо сделать, чтобы он на другом листе выглядел так

т.е. встречается и например 5 раз.

только надо это сделать с учетом Стеммера
я нашел один, но он этот алгоритм на java
http://www.algorithmist.ru/2010/12/porter-stemmer-russian.html
а тут стоп слова к нему.
http://www.algorithmist.ru/2010/12/stop-symbols-in-russian.html

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

Цитата:

Если имеется ввиду, что в ячейках C5:C70 полные наименования, а в ячейках D5:D70 сокращенные, то так:

имеется ввиду, что в диапозоне ячеек C5:D70 заданы списки из значений столбца А второго листа.
А в настоящее время имеется чередование полных и сокращенных названий на втором листе:
столбцы A,C,E,G с полными названиями
столбцы B,D,F,H со сокращенными названиями

возможна ли вариация кода для данного случая?

Alexey87

Цитата:

в диапозоне ячеек C5:D70 заданы списки из значений столбца А второго листа

А где данные столбца B?

Цитата:

А где данные столбца B?

на втором листе, где и полные названия (столбец А)

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

Код: Function СУММ_ЦВЕТ10(Диапазон_суммирования As Range, Optional Цвет_берется_из_ячейки As Range)
If Not Цвет_берется_из_ячейки Is Nothing Then
For Each cll In Диапазон_суммирования.Cells
If cll.Interior.ColorIndex <> 4 And cll.Interior.ColorIndex <> -4142 And cll.Interior.ColorIndex <> 35 _
And cll.EntireRow.Hidden = False Then
summa = summa + cll.Value
End If
Next
Else
For Each cll In Диапазон_суммирования.Cells
If cll.Interior.ColorIndex = Цвет_берется_из_ячейки.Interior.ColorIndex _
And cll.EntireRow.Hidden = False Then
summa = summa + cll.Value
End If
Next
End If
СУММ_ЦВЕТ10 = summa
End Function