Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.55/11: Рейтинг темы: голосов - 11, средняя оценка - 4.55
1 / 1 / 0
Регистрация: 20.07.2011
Сообщений: 93
1

Функции для поиска, выбора и вставки

24.06.2006, 12:57. Просмотров 2098. Ответов 11
Метки нет (Все метки)


Доброго времени суток!
Возникла вот такая задача, если кто может помочь советом или примером ее решения, буду благодарен!
В ячейках А1, А2, А3, А4 есть информация след типа
Проволока Ф2мм
Проволока Ф2,5
Профиль 20х20
Проволока Ф4мм
Нужно произвести поиск по ячекам А1. А2, А3, А4 и если в них есть слово проволока , выбрать содержащиеся в этой же ячейке цифровые элементы и вставить в ячейку А15 и ниже, взависимости от того сколько потребуется.
В итоге в ячейках А15, А16,А17 должно получиться следующее:
2
2,5
4
Пробовал стандартными функциями Экзеля, но нечего неполучилось
Заранее спасибо!
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
24.06.2006, 12:57
Ответы с готовыми решениями:

Макрос для поиска и вставки текста
Друзья, помогите, пожалуйста, с простенькой задачкой. Пусть, помимо прочего текста, в документе...

Выбор структуры данных для вставки, удаления и поиска минимума за log(n)
Добрый день!Подскажите какую нибудь структуру, чтобы были операции: вставка,удаление,и поиск...

В программе написать функции: вставки элемента, поиска максимального элемента, определения среднего арифметического элементов массива
В целочисленном массиве Х(N) после каждого четного числа вставить максимальный элемент массива....

Ошибка в SQL: Список выбора для инструкции INSERT содержит меньшее число элементов, чем список вставки
Всем привет. возникла проблема с заполнением таблицы из других таблиц. USE GO INSERT INTO ....

11
Alex77
25.06.2006, 11:26 2
Вставь и запусти макрос
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 25.06.06 (АлексАндр)
'
Dim St, Di, j, N, K
j = 15
St = InputBox("Введите наименование", "Шо ищем", "Проволока")
    For i = 2 To 14 '
            
 If InStr(1, (Range("A" & i).Value), St) > 0 Then
    
 N = InStr(1, (Range("A" & i).Value), "Ф") + 1 ' начало выборки
 K = InStr(N, (Range("A" & i).Value), "м") ' конец выборки
        If K = 0 Then
        K = N + 3
        End If
Selection.Value = Mid(Range("A" & i).Value, N, K - N)
j = j + 1
 End If
 
 Next i
        
End Sub
1 / 1 / 0
Регистрация: 20.07.2011
Сообщений: 93
26.06.2006, 12:16  [ТС] 3
Да почти то что надо!
Но очень хотелось бы использовать автопоис без Инпута , постоянно ищется Проволока, так зачем же лишний раз писать ее.
0
3 / 3 / 0
Регистрация: 08.09.2011
Сообщений: 111
26.06.2006, 12:51 4
Можно попробовать этот вариант. Правда там разбивка ФИО на составляющие, но по сути похоже, что подойдет...
0
3 / 3 / 0
Регистрация: 08.09.2011
Сообщений: 111
26.06.2006, 12:54 5
А вот и файл, чё-то не приаттачился в первый раз....
0
1 / 1 / 0
Регистрация: 20.07.2011
Сообщений: 93
26.06.2006, 14:56  [ТС] 6
Tsvet (26.06.2006)
А вот и файл, чё-то не приаттачился в первый раз....
Не удаеться скачать
0
3 / 3 / 0
Регистрация: 08.09.2011
Сообщений: 111
26.06.2006, 15:21 7
Вот тогда в RAR ...
0
3 / 3 / 0
Регистрация: 08.09.2011
Сообщений: 111
26.06.2006, 15:26 8
А, не понял сначала, наверное с сайтом беда какая-то...
Короче там все в таком вот виде (если русский Excel, тогда, ессесьно, надо имена функций заменить....)
<TABLE class=MsoTableGrid style="BORDER-RIGHT: medium none; BORDER-TOP: medium none; BORDER-LEFT: medium none; WIDTH: 491.4pt; BORDER-BOTTOM: medium none; BORDER-COLLAPSE: collapse; mso-border-alt: solid windowtext .5pt; mso-yfti-tbllook: 480; mso-padding-alt: 0cm 5.4pt 0cm 5.4pt; mso-border-insideh: .5pt solid windowtext; mso-border-insidev: .5pt solid windowtext" cellSpacing=0 cellPadding=0 width=655 border=1><TBODY><TR style="mso-yfti-irow: 0; mso-yfti-firstrow: yes <TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 5.4pt; BORDER-TOP: windowtext 1pt solid; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: windowtext 1pt solid; WIDTH: 50.4pt; PADDING-TOP: 0cm; BORDER-BOTTOM: windowtext 1pt solid; BACKGROUND-COLOR: transparent; mso-border-alt: solid windowtext .5pt" vAlign=top width=67><P class=MsoNormal style="MARGIN: 0cm 0cm 0pt <FONT size=3><FONT face="Times New Roman Адрес<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o></o></P></TD><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 5.4pt; BORDER-TOP: windowtext 1pt solid; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: #d4d0c8; WIDTH: 441pt; PADDING-TOP: 0cm; BORDER-BOTTOM: windowtext 1pt solid; BACKGROUND-COLOR: transparent; mso-border-alt: solid windowtext .5pt; mso-border-left-alt: solid windowtext .5pt" vAlign=top width=588><P class=MsoNormal style="MARGIN: 0cm 0cm 0pt <SPAN style="FONT-SIZE: 10pt <FONT face="Times New Roman Формула<o></o></SPAN></P></TD></TR><TR style="mso-yfti-irow: 1 <TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: windowtext 1pt solid; WIDTH: 50.4pt; PADDING-TOP: 0cm; BORDER-BOTTOM: windowtext 1pt solid; BACKGROUND-COLOR: transparent; mso-border-alt: solid windowtext .5pt; mso-border-top-alt: solid windowtext .5pt" vAlign=top width=67><P class=MsoNormal style="MARGIN: 0cm 0cm 0pt <FONT size=3><FONT face="Times New Roman А1<o></o></P></TD><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: #d4d0c8; WIDTH: 441pt; PADDING-TOP: 0cm; BORDER-BOTTOM: windowtext 1pt solid; BACKGROUND-COLOR: transparent; mso-border-alt: solid windowtext .5pt; mso-border-left-alt: solid windowtext .5pt; mso-border-top-alt: solid windowtext .5pt" vAlign=top width=588><P class=MsoNormal style="MARGIN: 0cm 0cm 0pt <SPAN style="FONT-SIZE: 10pt <FONT face="Times New Roman Иванов Иван Иванович<o></o></SPAN></P></TD></TR><TR style="mso-yfti-irow: 2 <TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: windowtext 1pt solid; WIDTH: 50.4pt; PADDING-TOP: 0cm; BORDER-BOTTOM: windowtext 1pt solid; BACKGROUND-COLOR: transparent; mso-border-alt: solid windowtext .5pt; mso-border-top-alt: solid windowtext .5pt" vAlign=top width=67><P class=MsoNormal style="MARGIN: 0cm 0cm 0pt <SPAN lang=EN-US style="mso-ansi-language: EN-US <FONT size=3><FONT face="Times New Roman B1<o></o></SPAN></P></TD><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: #d4d0c8; WIDTH: 441pt; PADDING-TOP: 0cm; BORDER-BOTTOM: windowtext 1pt solid; BACKGROUND-COLOR: transparent; mso-border-alt: solid windowtext .5pt; mso-border-left-alt: solid windowtext .5pt; mso-border-top-alt: solid windowtext .5pt" vAlign=top width=588><P class=MsoNormal style="MARGIN: 0cm 0cm 0pt <SP
0
1 / 1 / 0
Регистрация: 20.07.2011
Сообщений: 93
26.06.2006, 16:30  [ТС] 9
Отписался в личку
0
5 / 5 / 3
Регистрация: 17.10.2007
Сообщений: 1,119
28.06.2006, 19:33 10
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Sub CommandButton1_Click()
    ExtractNumbers "Wire", "A1:A4", "A15", "A19"
End Sub
Private Sub ExtractNumbers(ByVal pstrItem As String, ByVal pstrRangeAddress, _
                                          ByVal pstrResultAddress As String, _
                                          ByVal pstrResultAddressEnd As String)
    Dim oFindRange As Range
    Dim strFirstAddress As String
    Dim intRow As Integer
    Worksheets(1).Range(pstrResultAddress & ":" & pstrResultAddressEnd).ClearContents
    With Worksheets(1).Range(pstrRangeAddress)
        Set oFindRange = .Find(pstrItem, LookIn:=xlValues, LookAt:=xlPart)
        If Not oFindRange Is Nothing Then
            strFirstAddress = oFindRange.Address
            Do
                Worksheets(1).Range(pstrResultAddress).Cells.Offset(intRow, 0).Value = GetNumber(oFindRange.Value)
                intRow = intRow + 1
                Set oFindRange = .FindNext(oFindRange)
            Loop While Not oFindRange Is Nothing And oFindRange.Address <> strFirstAddress
        End If
    End With
End Sub
Private Function GetNumber(ByVal pstrText As String) As String
    Dim objRegExp As New RegExp
    Dim strReturn As String
    With objRegExp
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = "d+(.d+){0,1}"
        If .Test(pstrText) Then
            strReturn = .Execute(pstrText)(0)
        Else
            strReturn = ""
        End If
    End With
    GetNumber = strReturn
    
    Set objRegExp = Nothing
End Function
VladConn
0
Adviser-faa
29.06.2006, 17:34 11
а самый тупой способ: автозаменой убрать "* " (звёздочка пробел)
:-D
Alex77
30.06.2006, 03:08 12
Evrodiller (26.06.2006)
Да почти то что надо!
Но очень хотелось бы использовать автопоис без Инпута , постоянно ищется Проволока, так зачем же лишний раз писать ее.
измени строку
St = InputBox("Введите наименование", "Шо ищем", "Проволока")
на
St = "Проволока"
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
30.06.2006, 03:08

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь или здесь.

Напишите подпрограммы для вставки и удаления элементов массива, а также подпрограммы для поиска min и max элементов
Напишите подпрограммы для вставки и удаления элементов массива, а также подпрограммы для поиска...

Алгоритмы вставки и выбора в С++
Алгоритмы вставки и выбора в С++

Реализовать функции для вставки и удаления строк
задание звучит так: Реализовать функции для вставки и удаления строк аналогичные процедурам Insert...

Функции для вставки текста и его вывода
День добрый! Какие функции используются для правильной вставки текста с кавычками, запятыми,...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
12
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.