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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 01.11.2009, 10:51   #1
Артур Иваныч
Форумчанин
 
Регистрация: 30.10.2009
Сообщений: 138
По умолчанию Поиск нужной строки и добавление записи

Всем здравствуйте!
имеется вот такой код:

Private Sub cmndbOK_Click()
If Me.TextBox2 = "" Then MsgBox "Вы не заполнили поле " & Chr(34) & "Название" & Chr(34), vbCritical, "": Exit Sub

Dim lLastRow As Long, li As Long
Application.ScreenUpdating = False
lLastRow = Cells(11, 1).End(xlDown).Row
On Error Resume Next
Rows("12:" & lLastRow).Rows.Ungroup
On Error GoTo 0
Rows(lLastRow + 1).Resize(1).Insert
Rows(lLastRow).Copy Rows(lLastRow + 1 & ":" & lLastRow + 1)
For li = lLastRow + 1 To lLastRow + 1
Rows(li).ClearContents
Cells(li, 1) = Replace(Val(Cells(li - 1, 1)) + "0,1", ",", ".") & ".": Cells(li, 3) = Me.TextBox2
Next li
Rows(12 & ":" & lLastRow + (1)).Rows.Group
Application.ScreenUpdating = True
End Sub

Этот код добавляет в 12ую строку записи(строки), но мне нужно вот что:
1) организовать поиск типа(и другие виды поиска подойдут, необязательно такой, я просто свой пример привёл) такого:

Dim rng As Range
Dim MyFullName As String
MyFullName = TextBox1.Text
Set rng = .Find(MyFullName, LookIn:=xlValues)
If Not (rng Is Nothing) Then
firstAddress = rng.Address
Do
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> firstAddress
Else
MsgBox "НЕТ такого"
End If
End With

Который находил бы по таблице слово(строку) и вместо 12ой строки вставлял строку найденного поиском значения. и вставлял записи в эту строку.
2) как мне видоизменить строку:
Cells(li, 1) = Replace(Val(Cells(li - 1, 1)) + "0,1", ",", ".") & ".": Cells(li, 3) = Me.TextBox2
чтобы счётчик шёл не от 1.1. до 1.9., а от 1.1. до 1.99?
заранее благодарен тому, кто поможет разобраться!
надеюсь я всё понятно объяснил
Артур Иваныч вне форума Ответить с цитированием
Старый 01.11.2009, 10:56   #2
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

Цитата:
Который находил бы по таблице слово(строку) и вместо 12ой строки вставлял строку найденного поиском значения. и вставлял записи в эту строку.
Что искать?
Где искать?

Воссоздавать ваш файл вместе с формой лишь для того, чтобы изменить одну строку кода, - как-то не очень хочется...
Будет файл с подобными разъяснениями - будет код.
EducatedFool вне форума Ответить с цитированием
Старый 01.11.2009, 11:12   #3
Артур Иваныч
Форумчанин
 
Регистрация: 30.10.2009
Сообщений: 138
По умолчанию

Вобщем у меня код не совсем правильно работает, внизу файл я прикрепил!
мне нужно чтобы поиском я находил "Название темы", в даннном примере название этих тем таковы: "Название темы НИОКР - 1", "Название темы НИОКР - 2" и "Название темы НИОКР - 3", мне нужен поиск через Find, вводить то что ищем в ТексБокс!
потом с помощью поиска мы нашли нужную тему и добавляем к нему этап, соблюдая
1) счётчик(столбец №)
2) порядок(чтобы друг за другом этапы следовали)
3) группировку
Вложения
Тип файла: rar файл.rar (19.6 Кб, 14 просмотров)
Артур Иваныч вне форума Ответить с цитированием
Старый 01.11.2009, 12:23   #4
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

Могу предложить такой вариант:
Код:
Private Sub cmndbOK_Click()
    On Error Resume Next: Dim ro As Range, cell As Range
    Set cell = [c:c].Find(Me.ComboBox1): Set ro = LastRow(cell).EntireRow
    ro.Offset(1).Resize(Me.TextBox3).Insert: ro.Resize(Me.TextBox3 + 1).FillDown
    ro.Offset(1).Resize(Me.TextBox3).ClearContents
    ro.Offset(1).Resize(Me.TextBox3, 1).FormulaLocal = _
    "=""" & cell.EntireRow.Cells(1) & """&строка()-" & cell.Row & "&""."""
End Sub

Private Sub CommandButton2_Click(): Unload UserForm1: End Sub
Private Sub SpinButton1_Change(): TextBox3 = SpinButton1.Value: End Sub
Private Sub TextBox3_Change(): Me.cmndbOK.Enabled = Val(Me.TextBox3) > 0: End Sub

Private Sub UserForm_Initialize()
    On Error Resume Next: Dim cell As Range, ra As Range
    Set ra = Range([c10], Range("c" & Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        If cell.HorizontalAlignment = xlCenter Then Me.ComboBox1.AddItem cell
    Next cell
    Me.ComboBox1.ListIndex = 0
End Sub

Function LastRow(ByVal cell As Range) As Range
    While cell.Offset(1).Interior.ColorIndex = 36: Set cell = cell.Offset(1): Wend
    Set LastRow = cell
End Function
Пример файла:




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

№ п.п. формируется при помощи формул типа этой:
Код:
  Ячейка: A20     Формула  (стиль A1):   ="2."&СТРОКА()-14&"."
                  Формула  (стиль R1C1): ="2."&СТРОКА()-14&"."
Если количество добавляемых строк = 0, кнопка Добавить строки становится недоступной
Запретил ручное изменение количества добавляемых строк, и списка направлений.

Последний раз редактировалось EducatedFool; 01.11.2009 в 12:25.
EducatedFool вне форума Ответить с цитированием
Старый 01.11.2009, 12:27   #5
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

см.вложение

макрос срабатывает по двойному щелчку в первой колонке.
ограничения
1.щелкать надо по последней строке подэтапов. потому что нумерация вставленных строк продолжится с номера, находящегося в затронутой ячейке
2.в ячейке должна быть запись типа "#.#." (точка между цифрами обязательна!). где # цифра или группа цифр. макрос выделяет вторую группу цифр и вставляет в строки, последовательно увеличивая значение.
Вложения
Тип файла: rar Книга192.rar (21.8 Кб, 25 просмотров)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 01.11.2009, 12:42   #6
Артур Иваныч
Форумчанин
 
Регистрация: 30.10.2009
Сообщений: 138
По умолчанию

Ребята, большое спасибо за помощь! Всё хорошо работает!
НО
комбобокс НЕ подходит
так как названий тем НИОКР может быть не 3 штуки
а хоть 10
или 100
причём постоянно меняется, добавляются новые или удаляются..
Артур Иваныч вне форума Ответить с цитированием
Старый 01.11.2009, 12:47   #7
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

Цитата:
комбобокс НЕ подходит
так как названий тем НИОКР может быть не 3 штуки
а хоть 10
или 100
Да хоть 1000
Все эти названия тем попадут в комбобокс

Впрочем, Вам виднее...
EducatedFool вне форума Ответить с цитированием
Старый 01.11.2009, 13:04   #8
Артур Иваныч
Форумчанин
 
Регистрация: 30.10.2009
Сообщений: 138
По умолчанию

аа вот как))
извините, не посмотрел)невнимательность!
Спасибо большое за помощь!
Очень признателен!
Артур Иваныч вне форума Ответить с цитированием
Старый 01.11.2009, 13:07   #9
Артур Иваныч
Форумчанин
 
Регистрация: 30.10.2009
Сообщений: 138
По умолчанию

Но группировка к сожелению не соблюдается((
Вы посмотрте, пожалуйсто, на мой фал,который я изначально выложил и обратите внимание на группировку строк, как группировка у меня там.
и как у Вас.
Артур Иваныч вне форума Ответить с цитированием
Старый 01.11.2009, 13:10   #10
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

если добавить это
Код:
  Do Until Not (Cells(r, 1) Like "#*.#*.")
    c = c + 1
    Cells(r, 1) = Left(Target, p) & c & "."
    r = r + 1
  Loop
перед TheEnd:
то строки можно вставлять между уже существующими этапами. последующие перенумеруются.
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Обращение к нужной записи в файле Impuls1989 Общие вопросы C/C++ 17 20.10.2009 22:29
Добавление записи gitzzz Microsoft Office Access 2 23.06.2009 19:30
Добавление записи LLIYT БД в Delphi 15 09.06.2009 18:25
Добавление записи rn6hac БД в Delphi 3 02.06.2009 10:26
Добавление записи.... Droid БД в Delphi 2 04.06.2008 15:50