Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 24.01.2020, 16:53   #1
Snekich
Форумчанин
 
Аватар для Snekich
 
Регистрация: 19.11.2011
Сообщений: 128
По умолчанию Построение выборки элементов из совокупности пользовательской функцией

В создании пользовательских функциях я пока слаб, только начинаю разбираться в нюансах.
Обычными функциями в екселе данная задача у меня реализована, но нужно теперь весь алгоритм, если это возможно, уместить в одну пользовательскую функцию.
Реализация путем функции преследует цель быстрого переноса в разные файлы с большим объемом данных т.е. что бы не данные копировать в заранее подготовленный файл excel, а функцию копировать в файлы с данными.

Задача состоит в построении выборки элементов из генеральной совокупности по заданным условиям:

1) Из генеральной совокупности ("Столбец 1") выбираются все элементы, по которым значение в "Столбце 2" выше "Пороговой суммы 1"
2) Из генеральной совокупности ("Столбец 1") выбираются элементы, по которым значение в "Столбце 3" не равно пустоте (т.е. если стоит любой символ)
3) Из генеральной совокупности ("Столбец 1") производится случайная выборка элементов, с учетом следующего:
- в случайную выборку не попадают элементы, которые уже отобраны в п.1 и п.2
- в случайную выборку не попадают элементы, по которым значение в "Столбце 2" ниже "Пороговой суммы 2"
- количество элементов случайной выборки определяется по формуле:
= (S - Q) / S * X * Y
где
S - cумма значений Столбца 2 всех элементов генеральной совокупности
Q - cумма значений Столбца 2 для элементов отобранных в п.1 и п.2
X - Коэффициент Х
Y - Коэффициент Y

Цитата:
Столбец 1 (текстовые данные)
Столбец 2 (числовые данные)
Столбец 3 (текстовые данные)

94822\2-----700 000
44364\8-----441 040----------+
91942\2-----16 357 000
99351\3-----24 964 662
93764\9-----19 000 000
21588\5-----12 100 000
62713\4-----19 180 000
56255\4-----1 500 000
47254\5-----500 000----------+
38813\4-----47 500 000
Цитата:
Коэффициент Х = 0,80
Коэффициент Y = 0,15
Пороговая сумма 1 = 70 000 000
Пороговая сумма 2 = 10 000

Полагаю, что должна получиться пользовательская функция массива, что то типа:

Цитата:
=excerpt(A1:A99; B1:B99; C1:C99; D1; E1; F1)
где
A1:A99 - Столбец 1
B1:B99 - Столбец 2
C1:C99 - Столбец 3
D1 - Пороговая сумма 1
E1 - Пороговая сумма 2
F1 - Коэффициент Х
G1 - Коэффициент Y
Ну и предполагаю, чтобы выводился результат столбиком, это должна быть функция массива.

Буду очень признателен за помощь ну или хотя бы направьте меня в нужное русло))


Пока что пробую реализовать в обычном Sub, а потом переделаю под Function.
Код пока такой получился, но он не работает
Код:
Sub Массив()
Dim Smax As String
Dim Smin As String
Dim X As String
Dim Y As String
Dim i1 As Integer
Dim i2 As Integer

    
    Smax = 70000000
    Smin = 10000
    
    Dim ArrIN1() As Variant 'одномерный массив
    Dim ArrIN2() As Variant 'одномерный массив
    Dim ArrIN3() As Variant 'одномерный массив
    Dim ArrOUTtmp() As Variant 'одномерный массив
    Dim ArrOUTtmp2() As Variant 'одномерный массив
    Dim ArrOUT() As Variant 'одномерный массив
    
    
    ArrIN1 = Sheets("Совокупность").Range("A2:A4218").Value
    ArrIN2 = Sheets("Совокупность").Range("B2:B4218").Value
    ArrIN3 = Sheets("Совокупность").Range("C2:C4218").Value
    
    
    retval = UBound(ArrIN1) 'определяем индекс верхнего значения массива
   ReDim Preserve ArrOUTtmp(retval) 'создаем пустой массив такой же размерности, как исходный. В него будем записывать промежуточный результат, а потом запишем непустые значения в итоговый массив. Если же сразу записывать в итоговый массив поочередно значения, то надо будет каждый раз переопределять размерность массива, а это будет занимать много память и скажется на быстродействии кода.
        
    
        
        
    i2 = 0 'первый элемент временного массива ArrOUTtmp
    'перебираем значения массива и записываем в новый массив индексы элементов со значением больше, чем заданное значение
    For i1 = 0 To retval
    If CSng(ArrIN2(i1)) > Smax Then 'отбираем элементы со значением больше, чем заданное значение. При сравнении преобразуем формат в одинаковый для сравниваемых переменных.
    ArrOUTtmp(i2) = i1 ' записываем индекс
    End If
    i2 = i2 + 1
    Next i1
    
    'перебираем значения массива и записываем в новый массив индексы элементов со значением отличных от пустоты
    For i1 = 0 To retval
    If ArrIN3(i1) <> Empty Then 'отбираем элементы со значением отличных от пустоты
    ArrOUTtmp(i2) = i1 ' записываем индекс
    End If
    i2 = i2 + 1
    Next i1
    
    
    'вычисляем сумму всех элементов в столбце 2
    Suma = 0
    For i1 = 0 To retval
    S1 = S1 + ArrIN2(i1) 'сумма всех элементов
    Next
  '  MsgBox "Сумма элементов массива составляет - " & S
  
  
    'вычисляем сумму выбранных элементов в столбце 2
    Suma = 0
    For i1 = 0 To i2
    S2 = S2 + ArrIN2(ArrOUTtmp(i1)) 'суммируем элементы массива ArrIN2 с индексами хранящимися в массиве ArrOUTtmp
    Next
  '  MsgBox "Сумма элементов массива составляет - " & S2
    
    X = 0.8
    Y = 0.15
    
    T = (S1 - S2) / S1 * X * Y ' по этой формуле определяет количесво элементов, выбираемых случайно выборкой
    
    
'формируем массиф в котором хранятся индексы по которым будет проиводить случайную выборку
    
    i3 = 0
   For i1 = 0 To retval
    If CSng(ArrIN2(i1)) > Smin Then 'отбираем элементы со значением больше, чем заданное минимальное значение. При сравнении преобразуем формат в одинаковый для сравниваемых переменных.
    ind = 0 ' будем использовать как индикатор 0 или 1
    
    For i4 = 0 To i2
    If ArrOUTtmp(i4) = i1 Then ind = 1 'переключаем индикатор, если данный элемент уже попал в выборку т.е. находится в массиве ArrOUTtmp
    Next i4
    
    If ind = 0 Then
    ArrOUTtmp2(i3) = i1 ' записываем индекс (если значение в массиве ArrIN2 больше минимально установленного и если данный индекс ранее не был записан в массив ArrOUTtmp
    i3 = i3 + 1
    End If
    
    Next i1
    'итого получили массив ArrOUTtmp2 в котором индексы из которых рамдомно надо выбрать элементы в количсетве T
    
    
    
    'это код, который нашел на форуме, по рамдомному выбору элементов из совокупности. !!! пока не знаю как его переделать для выборки элементов из массива ArrOUTtmp2 и записать из в массив ArrOUTtmp
     Dim i5 As Long, Kolvo As Long, MKolvo As Long, a As Long, c As New Collection
  Kolvo = retval
  For i5 = 1 To Kolvo
      c.Add i
  Next
  MKolvo = T
  Randomize
  With Range("A1")
    For i = 1 To MKolvo
      a = Int(Rnd() * c.Count + 1)
      .Offset(i, 0) = c.Item(a)
      c.Remove (a)
    Next
  End With
    
    
    'итого на данном этапе мы должны получить массив ArrOUTtmp в котором записаны индексы элементов попавших в выборку из генеральной совокупности ArrIN1
    
    'теперь записываем значения массива ArrIN1 в массив ArrOUT в соответствии с выборкой индексов хранящихся в ArrOUTtmp
    
    For i1 = 0 To i2 'i2 это количество элементов записанный в массив ArrOUTtmp
    ArrOUT(i1) = ArrIN1(ArrOUTtmp(i1)) ' записываем нужные значение из генеральной совокупности в итоговый массив
    Next i1
    
    
    
    'записываем результат в столбец
    For i1 = 0 To i2
    Round("F" & i1 + 1) = ArrOUT(i1)
    Next i1

End Sub
Вложения
Тип файла: rar Построение выборки.rar (130.2 Кб, 0 просмотров)
Нет ничего невозможного, главное верить в это.

Последний раз редактировалось Snekich; 25.01.2020 в 14:06.
Snekich вне форума Ответить с цитированием
Старый 25.01.2020, 14:08   #2
Snekich
Форумчанин
 
Аватар для Snekich
 
Регистрация: 19.11.2011
Сообщений: 128
По умолчанию

Загрузил другой файл т.к. сначала по ошибке без макросов прикрепил файл.

Буду очень признателен за помощь с исправлением ошибок.
Пока что не могу заставить код работать.
Нет ничего невозможного, главное верить в это.
Snekich вне форума Ответить с цитированием
Старый 25.01.2020, 21:31   #3
Snekich
Форумчанин
 
Аватар для Snekich
 
Регистрация: 19.11.2011
Сообщений: 128
По умолчанию

Ошибки исправил.
В данной теме вопросов больше нет.
Нет ничего невозможного, главное верить в это.
Snekich вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Странность с пользовательской функцией motorway Microsoft Office Excel 10 24.02.2010 01:36
Генерация статистической совокупности T.N.T Помощь студентам 0 07.01.2010 20:25
Выбор из таблицы по двум параметрам и построение таблице на основе выборки WildKosha Microsoft Office Excel 2 08.08.2009 01:53
Построение выборки Pankratyeva Microsoft Office Excel 3 09.02.2009 15:45
Получение пользовательской функцией данных с закрытой книги KozakMamaj Microsoft Office Excel 18 22.10.2008 06:55