/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Basic/VBA

Выпуск № 736
от 23.03.2008, 17:35

Вопрос № 127.882

Доброго времени суток. Вопрос. Есть книга Excel, в ней два листа. В первом листе осуществляется ввод данных в ячейки, откуда после нажатия кнопки (макрос), данные переносятся на второй лист в базу данных. Один из столбцов второго листа содержит названия организаций. Как сделать, чтобы при вводе названия организации на первом листе, в ячейке после ввода первого символа (без учета регистра) выпадал список подсказки, после ввода второго символа список подсказки уменьшался (соответственно) и т.д. Причем выбор окончательного значения можно было осуществлять как мышой, так и с клавиатуры.

Отправлен: 18.03.2008, 09:43 Вопрос задал: Levochkin Andre (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Черников Игорь Владимирович Здравствуйте, Levochkin Andre! Dim temp Private Sub ComboBox1_Click() Application.Range(temp).Select Application.Selection.Value = ComboBox1.Value End Sub Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then Application.Range(temp).Select Application.Selection.Value = ComboBox1.Value Else ComboBox1.Activate End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim kod Dim i As Integer temp = Application.Selection.Address kod = Workbooks("Ëèñò Microsoft Excel.xls").Worksheets("Ëèñò1").Range("a1:a50") ComboBox1.List = kod For i = ComboBox1.ListCount - 1 To 0 Step -1 'Ïåðåáèðàåì çàïèñè ñ êîíöà If ComboBox1.List(i) = "" Then 'Óäàëÿåì ïóñòûå ComboBox1.RemoveItem i Else ComboBox1.List(i) = CStr(ComboBox1.List(i)) ' Ïðåîáðàçóåì â ñòðîêó End If Next i ComboBox1.Activate End Sub --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: 8-ой класс) Ответ отправлен: 18.03.2008, 20:35

Вопрос № 127.971

Добрый день. Вопрос такой. Если стандратная функция или способо, присвоения УНИКАЛЬНОГО случайного числа из заданной последовательности. Например, for i=1 to 10 a(i) = (10 * rnd) + 1 next i но а(i) могут повторяться. вопрос в том, как сделать случайную последовательность, без повторений.

Отправлен: 18.03.2008, 17:24 Вопрос задал: yazzer (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Павленко Александр Геннадьевич Здравствуйте, yazzer! Элементарно, Ватсон =) Новые сгенерированные числа сверяйте с уже полученными. Если совпадает, то генерировать заново. Есть конечно небольшая вероятность более долгого просчета из-за постоянных совпадений, но что поделаешь. Приложение: Const t As Integer = 10 'количество чисел Dim a(t), b, i, ist As Integer ist = 1 Do b = Int((t * Rnd) + 1) For i = 1 To ist If b = a(i) Then GoTo dalee Next i a(ist) = b ist = ist + 1 dalee: Loop Until ist = t + 1

Ответ отправил: Павленко Александр Геннадьевич (статус: 1-ый класс) Ответ отправлен: 18.03.2008, 18:13

Отвечает: Черников Игорь Владимирович Здравствуйте, yazzer! Dim a(1 To 10) As Integer ' Объявляем переменные Dim i As Integer Dim j As Integer For i = 1 To 10 'это Ваше, надеюсь знаете как работает a(i) = (10 * Rnd) + 1 Next i 10 i = 0'Здесь начинается проверка совпадений j = 0 For i = 1 To 10 For j = 1 To 10 If a(i) = a(j) And i <> j Then 'Проверяем на совпадение a(i) = (10 * Rnd) + 1'Заменяем совпавшие GoTo 10'Возвращаемся в начало проверки End If Next j Next i For i = 1 To 10'Выводим результат в окно отладки, чтобы убедиться, что всё правильно Debug.Print a(i) Next i Удачи! --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: 8-ой класс) Ответ отправлен: 18.03.2008, 18:58

Отвечает: Тесленко Евгений Алексеевич Здравствуйте, yazzer! подобной "стандартной" функции в VB(A) нет. для выполнения задачи можно воспользоваться следующим способом: создать двухмерный массив заполнить его случайными числами и "заданной последовательности" отсортировать массив по случайным числам. для сортировки двухмерных массивов в VB удобно использовать ADO Recordset, код в приложении. (к проекту должна быть подключена библиотека "Microsoft ActiveX Data Objects") В Excel VBA существует способ сортировки диапазона на листе. Можно заполнить первую колонку числами "заданной последовательности", вторую случайными числами, произвести сортировку диапазона по второй колонке. Какой способ Вам подойдет больше не знаю. Евгений. Приложение: Option Explicit Sub start() Dim dataArr() dataArr = Array(1, 2, 4, 6, 8) 'массив "заданной последовательности" sortArr dataArr() End Sub Function sortArr(dataArr()) 'Сортируем массив Dim j, i, iArr(), rst As New ADODB.Recordset i = UBound(dataArr) ReDim iArr(1, i) Randomize For j = 0 To i 'Заполняем двухмерный массив iArr(0, j) = dataArr(j): iArr(1, j) = Int((100 * Rnd) + 1) Next With rst 'Создаем рекордсет With .Fields .Append "f0", adInteger: .Append "f1", adDouble End With .CursorLocation = adUseClient: .Open For i = 0 To UBound(iArr, 2) 'Заполняем рекордсет .AddNew .Fields(1) = iArr(1, i): .Fields(0) = iArr(0, i) .Update Next i .Sort = "f1 ASC" 'Сортируем .MoveFirst: i = 0 Do Until rst.EOF 'Заполняем массив dataArr(i) = .Fields(0): i = i + 1: .MoveNext Loop .Close End With Set rst = Nothing End Function

Ответ отправил: Тесленко Евгений Алексеевич (статус: Студент) Ответ отправлен: 18.03.2008, 20:49

Отвечает: HookEst Здравствуйте, yazzer! Что-то я заинтересовался))... Хорошо было бы, наверное, Кнута почитать, но выскажу свои собственные соображения. Для выбора подходящего варианта, нужно знать особености требуемой последовательности, а именно: необходимое колличество элементов L (длину последовательности), и колличество N всех возможных значений, которые могут быть присвоены элементу, а еще точнее, то как соотносятся эти 2 параметра. Ясно, что L не может превышать N(все элементы должны быть уникальны). Два предложенных уже варианта( Павленко Александра Геннадьевича и Черникова Игоря Владимировича, ответ Евгения Алексеевича пока не беру) по сути являются методами "тыка", тыкнул в число, попал-хорошо, не попал - тыкнул опять и т.д... если N/L много больше 1(например, если N кол-во всех целых чисел), то метод отлично работает, но в случае приближения N/L к единице, вероятность успешного тыка для последних элементов последовательности стремительно сокращается. В таком случае, можно, например, создать сначала неслучайную последовательность все возможных значений(длиной N), а потом в случайном порядке выбирать из нее L значений, попутно удаляя их из этой последовательности, чтобы в следующий раз они уже не попадались. Чтобы не быть голословным, сделал тестик(результаты ниже, а код в приложении). в нем я тестирую время исполнения 5 вариантов получения уникальной последовательности целых положительных чисел, для разных значения L и N: COUNT_NUM - длина требуемой последовательности L; MIN_NUM,MAX_NUM - соответственно минимальное и максимальное значение, которое может принимать элемент(N=max-min+1); sub var1 - получает НЕ уникальную последовательность(это так, просто для сравнения); sub var2 - вариант Павленко Александра Геннадьевича, неплохо работает, но в случае если элемент может принимать значение 0, то если L=N - застревает на последнем элементе (я так понял, из-за того, что массив инициализируется нулями), но это наверное можно легко доработать, я же просто ограничил все значения положительными числами; sub var3 - вариант Черникова Игоря Владимировича, в случае большого COUNT_NUM я его пропускаю, т.к. ну очень долго ждать когда он закончится. т.к. вложенные циклы всегда полные (L-циклов) и сбрасываются(начинаются сначала) вслучае неудачного тыка; sub var4 - мой вариант метода тыка, но с проверкой не в цикле, а используя объект Collection, точнее его требования к уникальности ключей. т.е. я получаю случайное значение b, и пробую добавить в Collection item(не важно какой, у меня vbEmpty), но с ключем b(обязательно переводить в строку), если такое значение уже было(в Collection уже есть элемент с таким ключем), то тык - неудачный, возникнет ошибка, нужно опять тыкать. т.е. всю работу по поиску значения в последовательности берет на себя Collection (native код - часто быстрее); sub var5 - моя реализация метода, который я уже выше описал(без тыка). Здесь я сначала заполнил вспомогательный массив ta всеми значениями от MIN_NUM до MAX_NUM(просто в цикле, по порядку). и случайно выбираю оттуда значения для каждого элемента Arr(находимой последовательности), те значения которые уже выбрал, я не удаляю из массива(перестраивать массив-довольно сложно), а разделил массив(ta) на две части, та что левее cursor - для использованных значения, та что правее - для еще не использованных(в самом начале, cursor стоит на первом элементе ta) и теперь просто меняю местами значения в выбраном элементе и в элементе под курсором, а курсор перемещаю на следующий элемент, и следующее случайное значение я выбираю только из правой части. sub check - просто проверяет созданную последовательность на уникальность, простой вложенный цикл. старался поменьше менять чужие варианты, ну и может быть обсчитался где в краевых условиях, но я думаю на мои цели это не повлияло. теперь результат с выводами: первые 3 варианта - разница по времени небольшая, в пределах погрешности, особо принимать во внимание не стоит, но все-таки ------------------------------------------------------------- Condition 1 COUNT_NUM= 10 MIN_NUM= 1 MAX_NUM= 10 Var1 time: 0 ms :Failed! Var2 time: 0 ms :OK! Var3 time: 0 ms :OK! Var4 time: 1 ms :OK! Var5 time: 0 ms :OK! малые L и N - видно. что короткие циклы, даже в var3, быстрее чем работа с Collection ------------------------------------------------------------- ------------------------------------------------------------- Condition 2 COUNT_NUM= 10 MIN_NUM= 1 MAX_NUM= 10000 Var1 time: 0 ms :OK! Var2 time: 0 ms :OK! Var3 time: 0 ms :OK! Var4 time: 0 ms :OK! Var5 time: 1 ms :OK! малый L большой N и большой N/L - 5 вариант проигрывает из-за создания временого массива длиной N ------------------------------------------------------------- ------------------------------------------------------------- Condition 3 COUNT_NUM= 100 MIN_NUM= 1 MAX_NUM= 10000 Var1 time: 0 ms :OK! Var2 time: 0 ms :OK! Var3 time: 2 ms :OK! Var4 time: 1 ms :OK! Var5 time: 1 ms :OK! то же, что и в предыдущем, но L на 2 порядка больше, видно, что время выполнения полных вложенных циклов начинает увеличиваться. ------------------------------------------------------------- ------------------------------------------------------------- Condition 4 COUNT_NUM= 10000 MIN_NUM= 1 MAX_NUM= 10000 Var1 time: 1 ms :Failed! Var2 time: 18724 ms :OK! Var3 - skipped! Var4 time: 455 ms :OK! Var5 time: 8 ms :OK! большие L и N, N/L~1 - метод тыка проигрывает, а использование native кода дает преимущество перед длиными вложенными циклами(пусть даже они и не всегда полные) ------------------------------------------------------------- ------------------------------------------------------------- Condition 5 COUNT_NUM= 10000 MIN_NUM= 1 MAX_NUM= 100000 Var1 time: 2 ms :Failed! Var2 time: 2494 ms :OK! Var3 - skipped! Var4 time: 78 ms :OK! Var5 time: 21 ms :OK! большие L и N, большой N/L - метод тыка сильно выигрывает перед предыдущим вариантом, но все-таки var5 - впереди планеты всей, хоть и дольше из-за большЕго N. ------------------------------------------------------------- Вывод: для короткой последовательности - нечего мудрить, пара циклов и все дела, для больших чисел - нужно Кнута читать. в приложении код теста, комментировать его сейчас не буду, если честно, уже устал писать не знаю нужны ли кому мои мысли, но очень уж "поперло" из меня, sorry. Успехов. Приложение: Option Explicit Option Base 1 Private Declare Function mtime Lib "winmm.dll" Alias "timeGetTime" () As Long Private COUNT_NUM As Long Private MIN_NUM As Long Private MAX_NUM As Long Private Arr() As Long Sub t() Dim t As Long Dim i As Long For i = 1 To 5 Select Case (i) Case 1 COUNT_NUM = 10 MIN_NUM = 1 MAX_NUM = 10 Case 2 COUNT_NUM = 10 MIN_NUM = 1 MAX_NUM = 10000 Case 3 COUNT_NUM = 100 MIN_NUM = 1 MAX_NUM = 10000 Case 4 COUNT_NUM = 10000 MIN_NUM = 1 MAX_NUM = 10000 Case 5 COUNT_NUM = 10000 MIN_NUM = 1 MAX_NUM = 100000 End Select If COUNT_NUM < 1 Or COUNT_NUM > (MAX_NUM - MIN_NUM + 1) Then Debug.Print "Check your constatnts!": Exit Sub Debug.Print "-------------------------------------------------------------" Debug.Print "Condition "; i Debug.Print "COUNT_NUM="; COUNT_NUM; ; "MIN_NUM="; MIN_NUM; ; "MAX_NUM="; MAX_NUM t = mtime var1 t = mtime - t Debug.Print "Var1 time: "; t; "ms :"; check t = mtime var2 t = mtime - t Debug.Print "Var2 time: "; t; "ms :"; check If i > 3 Then Debug.Print "Var3 - skipped!" Else t = mtime var3 t = mtime - t Debug.Print "Var3 time: "; t; "ms :"; check End If t = mtime var4 t = mtime - t Debug.Print "Var4 time: "; t; "ms :"; check t = mtime var5 t = mtime - t Debug.Print "Var5 time: "; t; "ms :"; check Debug.Print "-------------------------------------------------------------" Next i End Sub Sub var1() ReDim Arr(COUNT_NUM) Dim i As Long For i = LBound(Arr) To UBound(Arr) Arr(i) = CLng((MAX_NUM - MIN_NUM) * Rnd + MIN_NUM) Next i End Sub Sub var2() ReDim Arr(COUNT_NUM) Dim b As Long Dim i As Long Dim ist As Long ist = 1 Do b = CLng((MAX_NUM - MIN_NUM) * Rnd + MIN_NUM) For i = 1 To ist If b = Arr(i) Then GoTo dalee Next i Arr(ist) = b ist = ist + 1 dalee: Loop Until ist > COUNT_NUM End Sub Sub var3() ReDim Arr(COUNT_NUM) Dim i As Long Dim j As Long For i = 1 To COUNT_NUM 'это Ваше, надеюсь знаете как работает Arr(i) = CLng((MAX_NUM - MIN_NUM) * Rnd + MIN_NUM) Next i 10 i = 0 'Здесь начинается проверка совпадений j = 0 For i = 1 To COUNT_NUM For j = 1 To COUNT_NUM If Arr(i) = Arr(j) And i <> j Then 'Проверяем на совпадение Arr(i) = CLng((MAX_NUM - MIN_NUM) * Rnd + MIN_NUM) 'Заменяем совпавшие GoTo 10 'Возвращаемся в начало проверки End If Next j Next i End Sub Sub var4() ReDim Arr(COUNT_NUM) Dim c As New Collection Dim i As Long Dim b As Long On Error GoTo FAIL For i = LBound(Arr) To UBound(Arr) b = CLng((MAX_NUM - MIN_NUM) * Rnd + MIN_NUM) check: c.Add vbEmpty, CStr(b) Arr(i) = b Next i Exit Sub FAIL: b = CLng((MAX_NUM - MIN_NUM) * Rnd + MIN_NUM) Resume check End Sub Sub var5() ReDim Arr(COUNT_NUM) ReDim ta(MAX_NUM - MIN_NUM + 1) Dim i As Long Dim j As Long Dim cursor As Long For i = MIN_NUM To MAX_NUM ta(i) = i Next i cursor = LBound(ta) For i = LBound(Arr) To UBound(Arr) j = CLng((UBound(ta) - cursor) * Rnd + cursor) Arr(i) = ta(j) ta(j) = ta(cursor) cursor = cursor + 1 Next i End Sub Function check() As String Dim i As Long Dim j As Long For i = LBound(Arr) To UBound(Arr) For j = i + 1 To UBound(Arr) If Arr(i) = Arr(j) Then check = "Failed!": Exit Function Next j Next i check = "OK!" End Function

Ответ отправил: HookEst (статус: Специалист) Ответ отправлен: 19.03.2008, 14:38

© 2001-2008, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.72.6 beta от 22.03.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru