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

Выпуск № 640
от 04.11.2007, 14:35

Вопрос № 106.731

Добрый день, уважаемые эксперты! Столкнулся с такой проблемой: у меня имеется Excel файл, в котором данные в таком виде (код)название (код)название (код)название (код)название (код)название (код)название то есть в отчет выводятся названия товаров и коды не в один столбец, а в разные в виде иерархического списка. Мне нужно собрать их в один столбец.... в ручную это не реально, так как файл большой.... если пытаюсь скопировать данные, например, с четвертого столбца в первый, то он затирает все данные с первого столбца само собой.... Как мне может макросом, может формулой, выделив эти ячейки перемистить все их в один столбец, чтобы уменя получился обычный список (код)название (код)название (код)название и т.д.

Отправлен: 25.10.2007, 13:49 Вопрос задал: Чернов С.В. (статус: 1-ый класс) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Тесленко Евгений Алексеевич Здравствуйте, Чернов С.В.! Попробуйте в "пятый" столбец вставить подобную формулу: =A1&B1. Скопировать содержимое "пятого" столбца. Вставить в первый столбец: Меню Правка_Специальная вставка_Значения Если дело только в сборке строки из данных двух ячеек, у Вас все должно получиться.;-) Евгений.

Ответ отправил: Тесленко Евгений Алексеевич (статус: Студент) Ответ отправлен: 25.10.2007, 17:03 Оценка за ответ: 5 Комментарий оценки: Да действительно, легко)))

Отвечает: Черников Игорь Владимирович Здравствуйте, Чернов С.В.! Это будет работать только в том случае, если в строке с 1 по 10 столбец кроме "(код)название" больше нет данных, иначе код соберёт их все и вставит в 11 столбец. chetchik=0 'укажите порядковый № строки с которой начинать минус 1 Do chetchik = chetchik + 1 For i = 1 To 10'указываем с 1 по 10 столбец(можно изменить на своё усмотрение) znachenie = znachenie & Worksheets("Лист1").Cells(chetchik, i).Value 'вместо Лист1 укажите свой Next i If znachenie = "" Then Exit Do 'Если данных нет, выйти из цикла Worksheets("Лист1").Cells(chetchik, 11).Value = znachenie 'Данные записываются в 11 столбец(можно поменять) znachenie = "" Loop можно и без макроса, формула будет примерно такой: =СЦЕПИТЬ(A1;B1;C1;...) для первой строки =СЦЕПИТЬ(A2;B2;C2;...) для второй и т.д. достаточно вставить первую фрмулу в нужный столбец верхней строки, а затем провести маркером(точка в нижнем правом углу ячейки) до последней строки с данными. Все данные соберутся построчно в одном столбце. Удачи! --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: 7-ой класс) Ответ отправлен: 25.10.2007, 19:25

Вопрос № 106.754

День добрый, Господа! Требуется Ваша авторитетное мнение) Возможно ли чтобы при запуске запроса надо было вводить не параметр, а выбрать условие отбора из списка, и что делать если надо выбрать несколько раз. В моем случае это такая цепочка: Предприятие-Цех-Наименование изделия-Марка ЖБИ, при этом хотелось бы что бы каждый следующий список содержал отфильтрованне данные предыдущего. Спасибо.

Отправлен: 25.10.2007, 16:19 Вопрос задал: Johnkrafchik (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Alexander N. Monastyrsky Здравствуйте, Johnkrafchik! В принципе данных недостаточно. Но я реализовал бы это следующим отбразом: - Каждый список - отдельная таблица БД. Наименование и 2а ключа. 1 - уникальный, 2 - групповой. - При загрузке формы заполненный 1й комбо. Каждый последующий загружается выбранным пунктом с данными отфильтрованной группы. Но это в VB, если используется БД. Если это VBA то неясно откуда берутся данные. Но принцип тотже. --------- Страшен Русский сервис, бессмысленный и беспощадный...

Ответ отправил: Alexander N. Monastyrsky (статус: 3-ий класс) Ответ отправлен: 25.10.2007, 16:42 Оценка за ответ: 5

Отвечает: Тесленко Евгений Алексеевич Здравствуйте, Johnkrafchik! Если речь о запросе формы MS Access, а "Предприятие-Цех-Наименование изделия-Марка ЖБИ" контролы формы, запрос может выглядеть так: SELECT * FROM Table WHERE Table.[Предприятие]=[Forms]![Форма]![Предприятие] and Table.[Цех]=[Forms]![Форма]![Цех] and .... События изменений в контролах должны обновлять запрос. например: Private Sub Предприятие_AfterUpdate() Me.Requery End Sub Так же можно создать процедуру которая будет выполнять тоже самое, но с помощью VBA, собирать запрос в строчную переменную ипередавать ее в качестве источника записей (RecordSource) форме или источника строк (RowSource) списку... Но это далеко не все возможные варианты. Евгений. Приложение:

Ответ отправил: Тесленко Евгений Алексеевич (статус: Студент) Ответ отправлен: 25.10.2007, 18:11 Оценка за ответ: 5

Вопрос № 106.848

Каким образом получить содержимое текстового поля сторонней формы? Есть форма с заголовком "MS Proga" на ней располагается скорее всего RichEdit компонент - вот как до него добраться? Может попробывать exe файл ResHackom и найти имя компонента чтобы затем его hwnd через FindWindowEx получить и через GetWindowText заиметь его значение? Есть ли другие предложения? Я делаю программку по сохранению истории общения в одном месагере.

Отправлен: 26.10.2007, 09:32 Вопрос задал: 4off Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Caspian Здравствуйте! Рекомендую restorator. Ссылки искать не буду, Вы без проблем найдёте в любом поисковике по запросу "программа restorator". Ознакомительный период 30 дней. Программа создана именно для таких задач.

Ответ отправил: Caspian (статус: 1-ый класс) Ответ отправлен: 26.10.2007, 22:17

Вопрос № 106.855

Здравствуйте! У меня следующая проблема. Мне надо открыть все документы из папки, в каждом документе произвести однотипную замену (слово "папа" заменить на "мама"). Существует ли в VBA команда для того, чтобы открыть несколько документов? Или, может быть, открыть все документы из какой-то папки, проделать необходимую операцию и закрыть? Или можно реализовать это на VB? Спасибо.

Отправлен: 26.10.2007, 10:25 Вопрос задал: Gene (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Alexander N. Monastyrsky Здравствуйте, Gene! В VBA можно переименовать файл, и даже папку. Требования к переименованию: - Файл/директория должен существовать. - В этот момент он должен быть закрыт. - Если файл открыт - генерится ошибка. Требуется сначала закрыть файл. - Название файла не должно содержать "*" и других вспомогательных символов. Только прямая ссылка на файл. Dim OldName, NewName OldName = "OLDFILE": NewName = "NEWFILE" ' Задаем имя файла. Name OldName As NewName ' Переименовуем файл. OldName = "C:MYDIROLDFILE": NewName = "C:YOURDIRNEWFILE" Name OldName As NewName ' Перемещаем и переименовуем файл. (можно неперемещать :))) --------- Страшен Русский сервис, бессмысленный и беспощадный...

Ответ отправил: Alexander N. Monastyrsky (статус: 3-ий класс) Ответ отправлен: 26.10.2007, 10:44

Отвечает: Залетин Виталий Викторович (мь!тарь) Здравствуйте, Gene! Если нужны только вордовские файлы, то можно их найти в нужной директории и, открывая по одному, выполнять замену нужного текста, например, так (макрос ворда): Sub ListFiles() Dim files() As String, file As String Dim iIter As Integer 'ищем файлы в папке c:11 iIter = 0 file = Dir$("c:11*.doc") 'пока функция Dir$ возвращает нам имя найденного очередного файла Do While Len(file) > 0 If file <> ThisDocument.Name Then 'это чтоб не забить свой файл, в котором выполняется макрос 'Заносим имя найденного файла в массив ReDim Preserve files(iIter) files(iIter) = file iIter = iIter + 1 End If file = Dir$ 'ищем дальше Loop 'теперь открываем каждый из найденных Dim doc As Word.Document For iIter = LBound(files) To UBound(files) Set doc = Word.Documents.Open(files(iIter)) 'открыли With doc With .Content.Find 'готовим объект поиска и замены .ClearFormatting 'не учитывая форматирование .Forward = True 'только вперед .Text = "Папа" 'текст, который ищем With .Replacement 'готовим объект замены .Text = "Мама" 'текст, которым будет заменен найденный текст .ClearFormatting 'не уитывая форматирование End With .Execute Replace:=Word.WdReplace.wdReplaceAll 'выполняем поиск и замену всех найденных образцов End With 'Если замена в документе не была произведена, свойство .Saved будет иметь значение True, иначе - False If .Saved = False Then 'замена текста была .SaveAs files(iIter) & " - Изменен.doc" 'сохраняем в новом файле End If .Close 'закрываем End With Set doc = Nothing 'убираемся за собой Next iIter End Sub В принципе, этот пример можно перенести и в полноценный VB 6, но там уже надо будет в проекте ссылка на Microsoft Word X.X Object Library (у Вас своя версия). По-моему, должно перенестись без проблем. Тут еще можно завести форму, где в текстовых полях указывать тексты поиска и замены и т. д. --------- Учиться никогда не поздно. Особенно программированию!

Ответ отправил: Залетин Виталий Викторович (мь!тарь) (статус: Студент) Ответ отправлен: 27.10.2007, 16:35

Отвечает: Черников Игорь Владимирович Здравствуйте, Gene! Это можно реализовать как в VBA, так и в VB6. Вот кусок программы, который ищет в указанной папке все документы (*.doc), открывает их по очереди, находит все слова "папа", заменяет их на "мама", сохраняет и закрывает. Dim appWD As Object Dim путь As String Dim файл As String Set appWD = CreateObject("Word.Application") 'Создаем ссылку на ворд путь = "C:" 'Указываем папку, в которой нужно искать файл = Dir(путь & "*.doc") 'Ищем первый вордовский файл Do If файл = "" Then Exit Do 'Если файлов больше нет, выходим из цыкла appWD.Documents.Open (путь & файл) 'Открываем найденный файл appWD.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument With appWD.Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "папа" 'Ищем текст папа .Replacement.Text = "мама" 'заменяем его на мама .Forward = True .Wrap = wdFindContinue .Format = False .Execute Replace:=wdReplaceAll End With appWD.ActiveDocument.Save 'сохраняем appWD.ActiveDocument.Close 'закрываем файл = Dir 'ищем следующий файл Loop --------- От каждого по способностям, каждому по труду

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

Вопрос № 107.216

Приветствую господа. Подскажите, плиз как решить проблему? В ячеке стоит время 7:09:08 считываю его в переменную Tim2 = Range(В1).Value Распечатываю переменную Tim2 MsgBox (Tim2) И вместо врени наблюдаю вот это 0,298

Отправлен: 29.10.2007, 11:11 Вопрос задал: Gat0r (статус: Посетитель) Всего ответов: 5 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Genyaa Здравствуйте, Gat0r! Все правильно... тип данных в ячейке, отформатированной под время, явлеятся действительным числом... и время в нем хранится в единицах доли суток прошедших от начала дня (количества дней даты от 1900 года (или от 1904 года) при этом - целая часть числа). (Да собственно, так хранятся данные даты и времени почти везде.) Чтобы увидеть значение времени в привычном нашем глазу виде, нужно форматировать это значение под формат времени: MsgBox Format(Tim2,"hh:mm:ss") --------- Всякое решение плодит новые проблемы.

Ответ отправил: Genyaa (статус: Студент) Ответ отправлен: 29.10.2007, 12:18

Отвечает: Alexander N. Monastyrsky Здравствуйте, Gat0r! Надо определить переменную как: Dim Tim2 As Date и все получится. --------- Страшен Русский сервис, бессмысленный и беспощадный...

Ответ отправил: Alexander N. Monastyrsky (статус: 3-ий класс) Ответ отправлен: 29.10.2007, 12:20

Отвечает: Iris Здравствуйте, Gat0r! Объявите переменную как Дата: Dim Tim2 As Date

Ответ отправила: Iris (статус: 1-ый класс) Ответ отправлен: 29.10.2007, 12:47

Отвечает: Черников Игорь Владимирович Здравствуйте, Gat0r! Нужно объявить переменную как Дата, тогда всё будет нормально, даже если ячейка имеет другой формат. Dim Tim2 As Date Tim2 = Worksheets("Лист1").Range("A1").Value MsgBox (Tim2) Вот только если неправильно ввести данные, то может возникнуть ошибка, тогда нужно проверять возможно ли эти данные преобразовать в дату или включить обработчик ошибок: Dim Tim2 As Date On Error GoTo ErrorHandler Tim2 = Worksheets("Лист1").Range("A1").Value MsgBox (Tim2) Exit Sub ErrorHandler: MsgBox ("Ошибка") --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: 7-ой класс) Ответ отправлен: 29.10.2007, 16:56

Отвечает: Тесленко Евгений Алексеевич Здравствуйте, Gat0r! Предлагаю вариант без преобразования: ' Tim2 = Range(В1).Text Евгений.

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

Вопрос № 107.304

Доброго дня! Процедура SvodBalans(), как нетрудно догадатся, сводит баланс из кучи однотипных файлов MS Exсel в один файл. Запрограммировано этакое "сквозное" суммирование ячеек по всем книгам. Нужные ячейки предварительно выделяются. Причём можно выделять несмежные диапазоны (Ctrl+). Проблема. Этот код даёт ошибку, если применяется на объединённые ячейки. Как поправить? Приложение: ' Процедура сводит баланс по всем ЖРЭУ города ' Public Sub SvodBalans() Books = Array("жрэу2.xls", "жрэу3.xls", "жрэу4.xls", "жрэу5.xls", "жрэу6.xls", "гостиница.xls", "ТВ.xls", "коммунальник.xls") Set wrkArea = Selection With ActiveWorkbook storeSheet = ActiveSheet.Name storePath = CurDir(ActiveWorkbook.Path) + "" For Each curRange In Range(wrkArea.Address) curRange.Select strFormula = "" For iBook = 0 To 7 Worksheets(storeSheet).Select strFormula = strFormula + "'" + storePath + "[" + Books(iBook) + "]" + _ ActiveSheet.Name + "'!" + curRange.Address(ReferenceStyle:=xlR1C1) + "," Next iBook ActiveCell.FormulaR1C1 = "=SUM(" + Left(strFormula, Len(strFormula) - 1) + ")" Next curRange ' Выделяем рабочий диапазон (чисто для наглядности) Range(wrkArea.Address).Select End With End Sub

Отправлен: 29.10.2007, 23:52 Вопрос задала: Shizuku Tsukishima (статус: 3-ий класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: HookEst Здравствуйте, Shizuku Tsukishima! Свойство Range.MergeArea - возвращает объединеные ячейки, если они объединены, или саму ячейку если она не объединена. соответствено Range.MergeArea.Cells(1) - возвратит самую первую ячейку, для объединения. Нам достаточно только составить и установить формулу для первой ячейки из объединения, остальные пропустить. И, прошу прощения, я немного поубирал с Вашего кода, как мне кажется лишнего. не обязательно писать Range(wrkArea.Address), можно просто wrkArea, а wrkArea у нас =Selection, и используется только один раз, я написал сразу: For Each curRange In Selection With ActiveBook - не нужен, мы к ActiveBook не обращаемся. и для работы с любым Range не обязательно его Select, вообще Selection менять лучше только там где действительно необходимо Public Sub SvodBalans2() Books = Array("жрэу2.xls", "жрэу3.xls", "жрэу4.xls", "жрэу5.xls", "жрэу6.xls", "гостиница.xls", "ТВ.xls", "коммунальник.xls") storePath = CurDir(ActiveWorkbook.Path) + "" sheetName = ActiveSheet.Name For Each curRange In Selection strFormula = "" 'если curRange - не первая ячейка диапазона, то ничего не делаем If curRange.MergeArea.Cells(1).Address = curRange.Address Then For iBook = LBound(Books) To UBound(Books) strFormula = strFormula + "'" + storePath + "[" + Books(iBook) + "]" + _ sheetName + "'!" + curRange.Address(ReferenceStyle:=xlR1C1) + "," Next iBook curRange.FormulaR1C1 = "=SUM(" + Left(strFormula, Len(strFormula) - 1) + ")" End If Next curRange End Sub Успехов.

Ответ отправил: HookEst (статус: Студент) Ответ отправлен: 30.10.2007, 06:39 Оценка за ответ: 5 Комментарий оценки: Отдельное спасибо за оптимизацию!

Вопрос № 107.316

Уважаемые эксперты помогите пожалуйста разобраться с примером описанным в книге. Здесь описанна простейщая программа шифрования. Все сделам как требуется но VB6 жалуется на оператор "+" в функции Encrypt, выкидывает окошко Compile Error: Variable required - can't assign to this expression. Приложение: Option Explicit Function Encrypt(infile As String) As Boolean Dim fileno1 As Integer Dim fileno2 As Integer Dim outfile As String Dim xpos As Long Dim x As Byte 'Âûâåñòè óêàçàòåëü ââèäå ïåñî÷íûõ ÷àñîâ MousePointer = vbHourglass xpos = 4 outfile = "c: emp.enc" fileno1 = FreeFile Open infile For Binary As fileno1 fileno2 = FreeFile Open outfile For Binary As fileno2 Put #fileno2, 1, 0 Put #fileno2, 2, 128 Put #fileno2, 3, 0 Put #fileno2, 4, 128 Do While Not EOF(fileno1) xpos = xpos + 1 Get #fileno1, xpos, x Get #fileno2, xpos, x + 128 Loop Close fileno2 Close fileno1 'Óäàëèòü èñõîäíûé ôàéë è çàìåíèòü åãî øèôðîâàííûì Kill infile FileCopy outfile.infile Kill outfile Encrypt = True 'Âîññòàíîâèòü óêàçàòåëü ìûøè MousePointer = vbNormal End Function Function GetFile() As String dlgFile.CancelError = True On Error GoTo filerr dlgFile.DialogTitle = "Âûáåðèòå ôàéë..." dlgFile.DefaultExt = "*.txt" dlgFile.Filter = "Òåêñòîâûå ôàéëû (*.txt)|*.txt*|Âñå ôàéëû (*.*)|*.*" dlgFile.FilterIndex = 1 dlgFile.MaxFileSize = 32767 dlgFile.ShowOpen GetFile = dlgFile.filename Exit Function filerr: GetFile = "" End Function Private Function Decrypt(infile As String) As Boolean Dim fileno1 As Integer Dim fileno2 As Integer Dim outfile As String Dim xpos As Long Dim x As Byte Dim t(3) As Byte 'Âûâåñòè óêàçàòåëü â âèäå ïåñî÷íûõ ÷àñîâ MousePointer = vbHourglass xpos = 4 outfile = "c: emp.enc" fileno1 = FreeFile Open infile For Binary As fileno1 fileno2 = FreeFile Get #fileno1, 1, t(0) Get #fileno1, 2, t(1) Get #fileno1, 3, t(2) Get #fileno1, 4, t(3) If (t(0) = 0 And t(1) = 128 And t(2) = 0 And t(3) = 128) Then Open outfile For Binary As fileno2 Do While Not EOF(fileno1) xpos = xpos + 1 Get #fileno1, xpos, x Get #fileno1, xpos - 4, x + 128 Loop Close fileno2 Decrypt = True Else Desrypt = False End If Close fileno1 'Óäàëèòü èñõîäíûé ôàéë è çàìåíèòü åãî øèôðîâàííûì If Decrypt Then Kill infile FileCopy outfile, infile Kill outfile End If 'Âîññòàíîâèòü óêàçàòåëü ìûøè MousePointer = vbNormal End Function Private Sub mnuActDecrypt_Click() Dim filename As String filename = GetFile() If filename <> "" Then If Decrypt(filename) = False Then MsgBox "Îøèáêà ïðè ðàñøèôðîâêå ôàéëà!" End If End If End Sub Private Sub mnuActEncrypt_Click() Dim filename As String filename = GetFile() If filename <> "" Then If Encrypt(filename) = False Then MsgBox "Îøèáêà ïðè øèôðîâàíèè ôàéëà!" End If End If End Sub Private Sub mnuFileExit_Click() End End Sub

Отправлен: 30.10.2007, 03:21 Вопрос задал: Аверин АС (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Евгений Неверов Здравствуйте, Аверин АС! У меня сейчас под рукой нет VB6, чтобы проверить, но догадка у меня есть. Ошибка находится в командах: Функция Encrypt: Get #fileno1, xpos, x Get #fileno2, xpos, x + 128 должно быть: Get #fileno1, xpos, x x = x + 128 Функция Decrypt: Get #fileno1, xpos, x Get #fileno1, xpos - 4, x + 128 должно быть: Get #fileno1, xpos, x xpos = xpos - 4 x = x + 128

Ответ отправил: Евгений Неверов (статус: Студент) Ответ отправлен: 30.10.2007, 05:04 Оценка за ответ: 5 Комментарий оценки: Спасибо. Буду исправлять!

Вопрос № 107.342

Приветствую господа. Подскажите плиз? Есть число Х=1234(знеков может быти как больше 12345 так и меньше 123) И есть гуппа чисел Y(тоже с различным количеством знаков) одно из чисел Y= (**1234**) содержит в себе число Х Подскажите плиз как отыскать число Y содержащее в себе число Х. Ваборка производится из таблиц exel. Чисел Х и У очень много порядка 50000 и мой алгоритм жутко тормозит. Поемного благодарен.

Отправлен: 30.10.2007, 10:09 Вопрос задал: Gat0r (статус: Посетитель) Всего ответов: 5 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Денисов Сергей Иванович Здравствуйте, Gat0r! Используйте выражение Instr(1, Str(Y), Str(X)) > 0 Если "истина", то содержит.

Ответ отправил: Денисов Сергей Иванович (статус: 1-ый класс) Ответ отправлен: 30.10.2007, 10:23

Отвечает: Тесленко Евгений Алексеевич Здравствуйте, Gat0r! http://ifolder.ru/3435362 По этой ссылке Вы найдете готовое решение этой задачи. Надстройка Excel ищет в выбраной колонке таблицы ячейки содержащие введенный текст и в указанной колонке ставит маркер. Код доступен для изучения. Евгений.

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

Отвечает: HookEst Здравствуйте, Gat0r! Хоть не получил ответа про поиск, отвечу. Вместо того, чтобы перебирать все ячейки листа и применять к каждой Instr(), можно использовать методы Range.Find() и Range.FindNext(). Собственный механизм поиска в Excel чаще гораздо быстрее и эффективнее ручного перебора. Например такой код будет выводить сообщения для все ячеек листа "SheetWithY", значения которых содержат в себе X Dim c as Range Dim firstAddress as String Dim X as Integer ..... X=... ... With Worksheets("SheetWithY").UsedRange Set c = .Find(What:=X, After:=.Cells(1), LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False) If Not c Is Nothing Then firstAddress = c.Address Do 'c - ячейка с искомой цифрой 'здесь делаете с ней все что Вам нужно, например MsgBox "Y=" & c.Value & " at " & c.Address Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If End With Успехов

Ответ отправил: HookEst (статус: Студент) Ответ отправлен: 31.10.2007, 06:51

Отвечает: Дмитрий Т. Здравствуйте, Gat0r! Как я понял у вас два массива - и Х, и Y, тогда попробуйте так: Отсортируйте оба списка по возрастанию(как строковых, а не числовых), далее запоминаете "адреса"-индексы для массива X, элементов которые начинаются с новой цифры(см. приложение). Берете первое число Y(1), "отрезаете" у него первую цифру и проверяете, а нет ли на на эту цифру у вас числа Х, просматриваете все иксы, на эту цифру(если все числа большие, т.е. длина их хотя бы с десяток цифр, то, по-моему, нужно все же сравнивать не через instr, а через mid$). А то он будет проверять всю строку Y. :( В общем далее проверяете вторую цифру Y(1), и т.д., второе число Y, ... Думаю, что также сократить немного время обработки поможет проверка, на длину чисел: если Y короче X, то X оно содержать никак не может.... Поэтому можно сделать двойную сортировку, или более глубокую адресацию: сортировка по первой цифре и потом по длине чисел, или адресацию по первум ДВУМ цифрам. Далее дело за вами. Надеюсь помог... Приложение: Сортировка по числовым признакам и строковым: Число Строка 123 11100023 124 123 125 124 11100023 125 адресация массива Х: 125 (1) 128 (2) 197584 (3) 3578 (4) 8765 (5) для единицы это будет первое же число, для двойки никакого, для тройки = 4 - четвертый элемент начинается с тройки, и для восьмерки = 5, для остальных цифр, опять же ничего...

Ответ отправил: Дмитрий Т. (статус: 2-ой класс) Ответ отправлен: 31.10.2007, 08:48

Отвечает: Черников Игорь Владимирович Здравствуйте, Gat0r! Dim x Dim y Dim z x = 123 y = 998123654 z = InStr(1, y, x) 'z указывает с какой позиции начинается искомое число, если не найдено, z=0 '1 - указывает с какой позиции начинать поиск в числе(или строке). 'у - где искать. 'х - что искать. If z > 0 Then MsgBox ("число " & y & " содержит " & x) --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: 7-ой класс) Ответ отправлен: 31.10.2007, 17:59

Вопрос № 107.375

Приветствую господа. Подскажите плиз. Выражение Instr(1, Str(Y), Str(X)) > 0 если Х=1234 а Y=1234**** (истино) если Х=1234 а Y=****1234 (ложно) (ложно) и при Instr(1......20 , Str(Y), Str(X)) > 0 хотя судя по описанию функции должно быть истино в обоих случаях. Премного благодарен.

Отправлен: 30.10.2007, 14:27 Вопрос задал: Gat0r (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Денисов Сергей Иванович Здравствуйте, Gat0r! Странно - У меня Instr(1, "****1234", "1234") > 0 True У Instr есть третий необязательный параметр - попробуй с ним поиграть ... Можно даже так попробовать: Instr(1, Y, X) > 0 - у меня работает. Но я на VBA живу !

Ответ отправил: Денисов Сергей Иванович (статус: 1-ый класс) Ответ отправлен: 30.10.2007, 15:12

Отвечает: HookEst Здравствуйте, Gat0r! Дело в том, что функция Str() всегда резервирует ведущий пробел для знака числа, если число отрицательное, первым символом результата будет "-", если число положительное, то пробел(а плюс подразумевается). т.е. на самом деле Вы сравниваете не "1234" и "****1234", а " 1234" и " ****1234", видно что к X добавляется пробел, а внутри Y его естественно нет. Или преобразовывайте числа явно, с помощью CStr(): InStr(1, СStr(Y), СStr(X)) или просто пишите: InStr(1, Y, X) Basic сам преобразует, как надо. Успехов.

Ответ отправил: HookEst (статус: Студент) Ответ отправлен: 31.10.2007, 08:29

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