Я метролог, решил облегчить себе и др. жизнь Есть проблема, не могу её решить, задача заполнение бланка "Свидетельства о поверке" посредством формы поиск из базы осуществляется по первым буквам ====сделал (использовал пример, нашел в инэте) вводится наименование, тип, и номер Госреестра средства измерения, и это все берется из листа ХХХ, который в свою очередь берет из листа БазаСИ и вставляется в лист РСИ (рабочее средство измерения) не получается привязать в динамическом режиме, периодичность поверки (выбранную строку из столбца С листа ХХХ) и др. столбцы в форму и сразу на бланк календарь ввел работает, сразу видно, что вводит дату в бланк, здесь вопросов нет, не получается редактировать заводской номер из формы если не устраивает, и др. подобные, "знак поверки", фамилию поверителя... вообщем, подскажите, дайте совет, ... код
Я метролог, решил облегчить себе и др. жизнь Есть проблема, не могу её решить, задача заполнение бланка "Свидетельства о поверке" посредством формы поиск из базы осуществляется по первым буквам ====сделал (использовал пример, нашел в инэте) вводится наименование, тип, и номер Госреестра средства измерения, и это все берется из листа ХХХ, который в свою очередь берет из листа БазаСИ и вставляется в лист РСИ (рабочее средство измерения) не получается привязать в динамическом режиме, периодичность поверки (выбранную строку из столбца С листа ХХХ) и др. столбцы в форму и сразу на бланк календарь ввел работает, сразу видно, что вводит дату в бланк, здесь вопросов нет, не получается редактировать заводской номер из формы если не устраивает, и др. подобные, "знак поверки", фамилию поверителя... вообщем, подскажите, дайте совет, ... кодcombat
combat, Добрый вечер, поскольку то, что Вы прислали, выглядит громоздким (по крайней мере изначально и для меня), вероятней было бы получить ответ на тот же вопрос. но в какой-нибудь упрощённой задаче (начинать с малого). Или как-нибудь подробнее расписать, хочу, чтобы если я делаю то то и то-то, получилось вот так...
combat, Добрый вечер, поскольку то, что Вы прислали, выглядит громоздким (по крайней мере изначально и для меня), вероятней было бы получить ответ на тот же вопрос. но в какой-нибудь упрощённой задаче (начинать с малого). Или как-нибудь подробнее расписать, хочу, чтобы если я делаю то то и то-то, получилось вот так...Roman777
понял при выборе из листбокса какой либо позиции, после нажатия кнопки ОК, происходит занесение только наименование и тип прибора, и все, не могу добиться того, что бы еще с той же выбранной строки заносилась информация и в другие ячейки выделены желтым, а также занесение/редактирование синих ячеек из той же формы вот например: при выборе из листбокса "Метран 510-ПКМ" не происходит занесение их листа ХХХ периодичности "12" в форму текстбокс "периодичность", наименование методики поверки и т.п. а также как редактироватиь ячейки с формы в динамическом режиме информации я ячейках синего цвета
понял при выборе из листбокса какой либо позиции, после нажатия кнопки ОК, происходит занесение только наименование и тип прибора, и все, не могу добиться того, что бы еще с той же выбранной строки заносилась информация и в другие ячейки выделены желтым, а также занесение/редактирование синих ячеек из той же формы вот например: при выборе из листбокса "Метран 510-ПКМ" не происходит занесение их листа ХХХ периодичности "12" в форму текстбокс "периодичность", наименование методики поверки и т.п. а также как редактироватиь ячейки с формы в динамическом режиме информации я ячейках синего цветаcombat
и еще Лист "БазаСИ " сокращен, а так будет больше 2,5 тыс, строк с информацией о средствах измерениях наименование, тип, номер гос.реестра, периодичность поверки, методика поверки, применяемые эталоны для поверки.
и еще Лист "БазаСИ " сокращен, а так будет больше 2,5 тыс, строк с информацией о средствах измерениях наименование, тип, номер гос.реестра, периодичность поверки, методика поверки, применяемые эталоны для поверки.combat
combat, просто функцией поиска ищете ячейку с наименованием аппарата в нужном листе, а далее используя cells().row определяете строку... которую нужно занести Ниже пример для периодичности подредактировал Ваше событие на выбор ListBox1. Сразу обращаю внимание. Если у Вас будут большие базы, то лучше всего использовать массивы для обработки информации, а никак не обращение к ячейкам типа как ниже приведено. [vba]
Код
Private Sub ListBox1_Change() CommandButton2.Enabled = ListBox1.ListIndex >= 0 ' когда выделена строка, в списке активна кн. ОК TextBox3.Text = Worksheets("ХХХ").Cells(Worksheets("ХХХ").Cells.Find(ListBox1.Text, , xlValues, xlPart).Row, 3).Value TextBox4.Text = ListBox1.Text TextBox5.Text = Txt End Sub
[/vba] или так, по сути без разницы: [vba]
Код
Private Sub ListBox1_Change() Dim rng As Range Set rng = Worksheets("ХХХ").Cells.Find(ListBox1.Text, , xlValues, xlPart) CommandButton2.Enabled = ListBox1.ListIndex >= 0 ' когда выделена строка, в списке активна кн. ОК TextBox3.Text = Worksheets("ХХХ").Cells(rng.Row, 3).Value TextBox4.Text = ListBox1.Text TextBox5.Text = Txt End Sub
[/vba]
combat, просто функцией поиска ищете ячейку с наименованием аппарата в нужном листе, а далее используя cells().row определяете строку... которую нужно занести Ниже пример для периодичности подредактировал Ваше событие на выбор ListBox1. Сразу обращаю внимание. Если у Вас будут большие базы, то лучше всего использовать массивы для обработки информации, а никак не обращение к ячейкам типа как ниже приведено. [vba]
Код
Private Sub ListBox1_Change() CommandButton2.Enabled = ListBox1.ListIndex >= 0 ' когда выделена строка, в списке активна кн. ОК TextBox3.Text = Worksheets("ХХХ").Cells(Worksheets("ХХХ").Cells.Find(ListBox1.Text, , xlValues, xlPart).Row, 3).Value TextBox4.Text = ListBox1.Text TextBox5.Text = Txt End Sub
[/vba] или так, по сути без разницы: [vba]
Код
Private Sub ListBox1_Change() Dim rng As Range Set rng = Worksheets("ХХХ").Cells.Find(ListBox1.Text, , xlValues, xlPart) CommandButton2.Enabled = ListBox1.ListIndex >= 0 ' когда выделена строка, в списке активна кн. ОК TextBox3.Text = Worksheets("ХХХ").Cells(rng.Row, 3).Value TextBox4.Text = ListBox1.Text TextBox5.Text = Txt End Sub
Обнаружилось, не корректная работа, при выборе типа средства измерения, допустим первый и второй (25), у них разная периодичность, разный госреестр и может и методика поверки быть разная и поэтому в списке отображается два одинаковых прибора но при выделении их в листбоксе, индикатор выбора (в вверху формы) показывает только первый. (здесь лучше посмотреть в работе, будет понятно) и еще как программно корректно делить предложение по строкам, вот у меня в листе РСИ в строках 15 и 18 делится предложение, через формулы на этом же листе как организовать программно, делить на две или даже 3 строки, причем первая меньше по количеству знаков чем 2 и если надо будет и 3 строку введу. вот смотрю и надо буде и тоже самое сделать для строки 28 где "Поверено в соответствии" то же не умещается, надо будет добавлять строку и прописывать код, как это реализовать программно Есть проблемы при работе на разных Офисах причем одного года 2007, хотелось бы чтобы работало везде
Обнаружилось, не корректная работа, при выборе типа средства измерения, допустим первый и второй (25), у них разная периодичность, разный госреестр и может и методика поверки быть разная и поэтому в списке отображается два одинаковых прибора но при выделении их в листбоксе, индикатор выбора (в вверху формы) показывает только первый. (здесь лучше посмотреть в работе, будет понятно) и еще как программно корректно делить предложение по строкам, вот у меня в листе РСИ в строках 15 и 18 делится предложение, через формулы на этом же листе как организовать программно, делить на две или даже 3 строки, причем первая меньше по количеству знаков чем 2 и если надо будет и 3 строку введу. вот смотрю и надо буде и тоже самое сделать для строки 28 где "Поверено в соответствии" то же не умещается, надо будет добавлять строку и прописывать код, как это реализовать программно Есть проблемы при работе на разных Офисах причем одного года 2007, хотелось бы чтобы работало вездеcombat
combat, Добрый день! Смотрите, я Вам показал лишь Вариант, как можно найти, грубо говоря строку по выбранному из листбокса тексту найти его на определённом листе. Я сам плохо знаю листбоксы и их свойства, но предпологаю, что можно вычислить. Более эффективно было бы, например, записать для каждого Listbox.list значение текущей строчки Cells().row в отдельный массив. При этом на листе надо определить данную переменную (массив) как Dim прям в самом листе, не внутри какой либо процедуры (забыл как это грамотно называется). Хотел было я привести пример и заметил, что поскольку у Вас в листбоксе нет никакой сортировки, отличающейся от сортировки в листе "БазаСИ", у Вас можно вычислить строку текущей позиции листа "БазаСИ" как ListIndex+1. А если же вы хотели бы в Листбоксе сделать иную сортировку, то можно было бы при записи листбокса сохранять данные в массив: [vba]
Код
Private Sub UserForm_Initialize() ......... ReDim SArr(1 To N) ReDim Arrr(1 To N) For R = 1 To N Sentence = Vs(R, 1) SArr(R) = " " & Replace(Sentence, """", "") ListBox1.AddItem R ListBox1.List(R - 1, 1) = Sentence Arrr(R - 1) = R Next .....
[/vba] а уже потом в ListBox1_Change() использовать этот массив: [vba]
Код
Arrr(ListBox1.listindex)
[/vba] - будет хранить значение аналогичное rng.row Кроме того, в этом случае информация будет более достоверной, чем при использовании [vba]
Код
.Cells.Find(ListBox1.Text, , xlValues, xlPart)
[/vba] Но повторюсь, в Вашем случае, вообще можно не создавать этого массива, а rng.row = ListBox1.listindex+1 Тоесть Вам достаточно поменять ListBox1_Change(): [vba]
Код
Private Sub ListBox1_Change() Dim roww As Long roww = UserForm2.ListBox1.ListIndex + 1 Lbl.Caption = Worksheets("БазаСИ").Cells(roww, 1).Value & " " & Worksheets("БазаСИ").Cells(roww, 2).Value _ & ", рег № " & Worksheets("БазаСИ").Cells(roww, 4).Value ' Наименование и тип СИ, рег № Lbl_Periud.Caption = Worksheets("БазаСИ").Cells(roww, 3).Value ' периодичность поверки DTPicker1.Enabled = True Lbl_mec.Visible = True LblDate2.Visible = True Lbl_NTD.Caption = Worksheets("БазаСИ").Cells(roww, 5).Value ' методика поверки ActiveSheet.Cells(28, 20) = Lbl_NTD.Caption T1.Text = Worksheets("БазаСИ").Cells(roww, 6).Value ' Используемые эталоны Worksheets("Обр").Cells(9, 1) = T1.Text End Sub
[/vba] Исправил, изначально было не верно).
combat, Добрый день! Смотрите, я Вам показал лишь Вариант, как можно найти, грубо говоря строку по выбранному из листбокса тексту найти его на определённом листе. Я сам плохо знаю листбоксы и их свойства, но предпологаю, что можно вычислить. Более эффективно было бы, например, записать для каждого Listbox.list значение текущей строчки Cells().row в отдельный массив. При этом на листе надо определить данную переменную (массив) как Dim прям в самом листе, не внутри какой либо процедуры (забыл как это грамотно называется). Хотел было я привести пример и заметил, что поскольку у Вас в листбоксе нет никакой сортировки, отличающейся от сортировки в листе "БазаСИ", у Вас можно вычислить строку текущей позиции листа "БазаСИ" как ListIndex+1. А если же вы хотели бы в Листбоксе сделать иную сортировку, то можно было бы при записи листбокса сохранять данные в массив: [vba]
Код
Private Sub UserForm_Initialize() ......... ReDim SArr(1 To N) ReDim Arrr(1 To N) For R = 1 To N Sentence = Vs(R, 1) SArr(R) = " " & Replace(Sentence, """", "") ListBox1.AddItem R ListBox1.List(R - 1, 1) = Sentence Arrr(R - 1) = R Next .....
[/vba] а уже потом в ListBox1_Change() использовать этот массив: [vba]
Код
Arrr(ListBox1.listindex)
[/vba] - будет хранить значение аналогичное rng.row Кроме того, в этом случае информация будет более достоверной, чем при использовании [vba]
Код
.Cells.Find(ListBox1.Text, , xlValues, xlPart)
[/vba] Но повторюсь, в Вашем случае, вообще можно не создавать этого массива, а rng.row = ListBox1.listindex+1 Тоесть Вам достаточно поменять ListBox1_Change(): [vba]
Код
Private Sub ListBox1_Change() Dim roww As Long roww = UserForm2.ListBox1.ListIndex + 1 Lbl.Caption = Worksheets("БазаСИ").Cells(roww, 1).Value & " " & Worksheets("БазаСИ").Cells(roww, 2).Value _ & ", рег № " & Worksheets("БазаСИ").Cells(roww, 4).Value ' Наименование и тип СИ, рег № Lbl_Periud.Caption = Worksheets("БазаСИ").Cells(roww, 3).Value ' периодичность поверки DTPicker1.Enabled = True Lbl_mec.Visible = True LblDate2.Visible = True Lbl_NTD.Caption = Worksheets("БазаСИ").Cells(roww, 5).Value ' методика поверки ActiveSheet.Cells(28, 20) = Lbl_NTD.Caption T1.Text = Worksheets("БазаСИ").Cells(roww, 6).Value ' Используемые эталоны Worksheets("Обр").Cells(9, 1) = T1.Text End Sub
[/vba] Исправил, изначально было не верно).Roman777
Много чего не знаю!!!!
Сообщение отредактировал Roman777 - Понедельник, 28.09.2015, 17:20
combat, Подскажите, пожалуйста, ато я не знаю. ListBox же автоматически имеет такую функцию поиска по первым буквам? Просто я имел дело ток с комбобоксом, а там эта функция встроена сама по себе...)
combat, Подскажите, пожалуйста, ато я не знаю. ListBox же автоматически имеет такую функцию поиска по первым буквам? Просто я имел дело ток с комбобоксом, а там эта функция встроена сама по себе...)Roman777
Много чего не знаю!!!!
Сообщение отредактировал Roman777 - Вторник, 29.09.2015, 09:25
combat, В общем, дело в том, что при срабатывании Вашего TextBox1_Change() индекс мы должны искать через: ListBox.Listindex, а при срабатывании ListBox1_Change() индекс выбранной позиции листа задаётся как Userform2.ListBox.Listindex. Это связано с положением методов внутри классов (если я не ошибаюсь, оч надеюсь здешние гуру меня поправят и правильно объяснят сей феномен). Поэтому пришлось объявить переменную roww глобально и задать пару условий в TextBox1_Change() и ListBox1_Change():
[vba]
Код
Option Explicit ' Dim SRng As Range ', InRng As Range Dim roww As Long Dim F As Integer Dim rng As Range Dim Vs(), SArr() As String, Sentence As String Dim R As Long, N As Long, Txt As String Dim sekret As Single ' Private Sub CommandButton1_Click() 'Отмена' Unload Me 'Закрыть форму End Sub ' Private Sub CommandButton2_Click() 'OK' R = ListBox1.List(ListBox1.ListIndex, 0) Worksheets("РСИ").Cells(3, 55) = Lbl.Caption Unload Me End Sub ' Private Sub ListBox1_Enter() If ListBox1.ListCount > 0 Then If ListBox1.ListIndex = -1 Then ListBox1.ListIndex = 0 End If
End Sub ' Private Sub TextBox1_Change() Dim Txt As String, K As Long ' Txt = " " & Trim(TextBox1.Text) F = 1 ' задаём условие, что при выполнении ТекстБокса F=1 ListBox1.Clear For R = 1 To N Sentence = SArr(R) If InStr(1, Sentence, Txt, vbTextCompare) > 0 Then ListBox1.AddItem R ListBox1.List(K, 1) = Vs(R, 1) K = K + 1 End If Next roww = ListBox1.ListIndex + 1 F = 0 ' задаём условие, что после отработки ТекстБокса F=0 - потому что вы потом будете тыкать в _ ЛистБокс, а там своё условие, что переменная roww будет переназначена только при F=0 CommandButton2.Enabled = False End Sub ' Private Sub UserForm_Initialize() ListBox1.ColumnCount = 2 ' ListBox1.ColumnWidths = "0;" CommandButton2.Enabled = False '........................................... Set SRng = Sheets("БазаСИ").Range("B1") 'первая ячейка списка' '........................................... Set SRng = Range(SRng, SRng.End(xlDown)) N = SRng.Rows.Count Vs = SRng.Value ReDim SArr(1 To N) For R = 1 To N Sentence = Vs(R, 1) SArr(R) = " " & Replace(Sentence, """", "") ListBox1.AddItem R ListBox1.List(R - 1, 1) = Sentence Next Lbl_SI.Caption = "Всего СИ в базе" & " " & N & " ед." End Sub Private Sub ListBox1_Change() If F <> 1 Then roww = UserForm2.ListBox1.ListIndex + 1 End If Lbl.Caption = Worksheets("БазаСИ").Cells(roww, 1).Value & " " & Worksheets("БазаСИ").Cells(roww, 2).Value _ & ", рег № " & Worksheets("БазаСИ").Cells(roww, 4).Value ' Наименование и тип СИ, рег № Lbl_Periud.Caption = Worksheets("БазаСИ").Cells(roww, 3).Value ' периодичность поверки DTPicker1.Enabled = True Lbl_mec.Visible = True LblDate2.Visible = True Lbl_NTD.Caption = Worksheets("БазаСИ").Cells(roww, 5).Value ' методика поверки ActiveSheet.Cells(28, 20) = Lbl_NTD.Caption T1.Text = Worksheets("БазаСИ").Cells(roww, 6).Value ' Используемые эталоны Worksheets("Обр").Cells(9, 1) = T1.Text End Sub
'Календарь ========================================================= Private Sub DTPicker1_Change() Dim Date0 As Date, Date1 As Date ListBox1.Enabled = False CommandButton3.Enabled = True
ActiveSheet.Cells(49, 2) = DTPicker1.Value Date0 = DTPicker1.Value ' Дата поверки Date1 = DateAdd("m", Lbl_Periud.Caption, Date0) LblDate2.Caption = Date1 ActiveSheet.Cells(13, 38) = Date1 CommandButton2.Enabled = LblDate2.Caption = Date1 End Sub
'Используемые эталоны ============================================================= Private Sub CommandButton3_Click() T11.Text = T1.Text T11.Visible = True End Sub
Private Sub CommandButton4_Click() T11.Visible = False Worksheets("Обр").Cells(9, 1) = T1.Text End Sub
Private Sub T11_Change() Worksheets("БазаСИ").Cells(rng.Row, 6).Value = T11.Text T1.Text = T11.Text End Sub
[/vba]
combat, В общем, дело в том, что при срабатывании Вашего TextBox1_Change() индекс мы должны искать через: ListBox.Listindex, а при срабатывании ListBox1_Change() индекс выбранной позиции листа задаётся как Userform2.ListBox.Listindex. Это связано с положением методов внутри классов (если я не ошибаюсь, оч надеюсь здешние гуру меня поправят и правильно объяснят сей феномен). Поэтому пришлось объявить переменную roww глобально и задать пару условий в TextBox1_Change() и ListBox1_Change():
[vba]
Код
Option Explicit ' Dim SRng As Range ', InRng As Range Dim roww As Long Dim F As Integer Dim rng As Range Dim Vs(), SArr() As String, Sentence As String Dim R As Long, N As Long, Txt As String Dim sekret As Single ' Private Sub CommandButton1_Click() 'Отмена' Unload Me 'Закрыть форму End Sub ' Private Sub CommandButton2_Click() 'OK' R = ListBox1.List(ListBox1.ListIndex, 0) Worksheets("РСИ").Cells(3, 55) = Lbl.Caption Unload Me End Sub ' Private Sub ListBox1_Enter() If ListBox1.ListCount > 0 Then If ListBox1.ListIndex = -1 Then ListBox1.ListIndex = 0 End If
End Sub ' Private Sub TextBox1_Change() Dim Txt As String, K As Long ' Txt = " " & Trim(TextBox1.Text) F = 1 ' задаём условие, что при выполнении ТекстБокса F=1 ListBox1.Clear For R = 1 To N Sentence = SArr(R) If InStr(1, Sentence, Txt, vbTextCompare) > 0 Then ListBox1.AddItem R ListBox1.List(K, 1) = Vs(R, 1) K = K + 1 End If Next roww = ListBox1.ListIndex + 1 F = 0 ' задаём условие, что после отработки ТекстБокса F=0 - потому что вы потом будете тыкать в _ ЛистБокс, а там своё условие, что переменная roww будет переназначена только при F=0 CommandButton2.Enabled = False End Sub ' Private Sub UserForm_Initialize() ListBox1.ColumnCount = 2 ' ListBox1.ColumnWidths = "0;" CommandButton2.Enabled = False '........................................... Set SRng = Sheets("БазаСИ").Range("B1") 'первая ячейка списка' '........................................... Set SRng = Range(SRng, SRng.End(xlDown)) N = SRng.Rows.Count Vs = SRng.Value ReDim SArr(1 To N) For R = 1 To N Sentence = Vs(R, 1) SArr(R) = " " & Replace(Sentence, """", "") ListBox1.AddItem R ListBox1.List(R - 1, 1) = Sentence Next Lbl_SI.Caption = "Всего СИ в базе" & " " & N & " ед." End Sub Private Sub ListBox1_Change() If F <> 1 Then roww = UserForm2.ListBox1.ListIndex + 1 End If Lbl.Caption = Worksheets("БазаСИ").Cells(roww, 1).Value & " " & Worksheets("БазаСИ").Cells(roww, 2).Value _ & ", рег № " & Worksheets("БазаСИ").Cells(roww, 4).Value ' Наименование и тип СИ, рег № Lbl_Periud.Caption = Worksheets("БазаСИ").Cells(roww, 3).Value ' периодичность поверки DTPicker1.Enabled = True Lbl_mec.Visible = True LblDate2.Visible = True Lbl_NTD.Caption = Worksheets("БазаСИ").Cells(roww, 5).Value ' методика поверки ActiveSheet.Cells(28, 20) = Lbl_NTD.Caption T1.Text = Worksheets("БазаСИ").Cells(roww, 6).Value ' Используемые эталоны Worksheets("Обр").Cells(9, 1) = T1.Text End Sub
'Календарь ========================================================= Private Sub DTPicker1_Change() Dim Date0 As Date, Date1 As Date ListBox1.Enabled = False CommandButton3.Enabled = True
ActiveSheet.Cells(49, 2) = DTPicker1.Value Date0 = DTPicker1.Value ' Дата поверки Date1 = DateAdd("m", Lbl_Periud.Caption, Date0) LblDate2.Caption = Date1 ActiveSheet.Cells(13, 38) = Date1 CommandButton2.Enabled = LblDate2.Caption = Date1 End Sub
'Используемые эталоны ============================================================= Private Sub CommandButton3_Click() T11.Text = T1.Text T11.Visible = True End Sub
Private Sub CommandButton4_Click() T11.Visible = False Worksheets("Обр").Cells(9, 1) = T1.Text End Sub
Private Sub T11_Change() Worksheets("БазаСИ").Cells(rng.Row, 6).Value = T11.Text T1.Text = T11.Text End Sub
поторопился, я что все работает теперь вылетело редактирование Применяемых эталонов самая последняя процедура
Private Sub T11_Change() Worksheets("БазаСИ").Cells(rng.Row, 6).Value = T11.Text T1.Text = T11.Text End Sub
здесь логически надо Cells(rng.Row, 6) поменять на Cells(roww. 6) и опять ругается, здесь то в чем дело?
еще нашел , то если используем поиск через текстбокс в лист боксе высвечивается правильно, а в верхнем индикаторе др. и в форму попадает др. СИ [moder]Оформите код тегами (кнопка #)[/moder]
здесь не понял?
поторопился, я что все работает теперь вылетело редактирование Применяемых эталонов самая последняя процедура
Private Sub T11_Change() Worksheets("БазаСИ").Cells(rng.Row, 6).Value = T11.Text T1.Text = T11.Text End Sub
здесь логически надо Cells(rng.Row, 6) поменять на Cells(roww. 6) и опять ругается, здесь то в чем дело?
еще нашел , то если используем поиск через текстбокс в лист боксе высвечивается правильно, а в верхнем индикаторе др. и в форму попадает др. СИ [moder]Оформите код тегами (кнопка #)[/moder]
combat, потому что он не знает что такое roww (чему оно равно), либо выходит та же ситуация что и в ListBox_Change() после введения текста в ТехtBox1. Можете мне сразу написать где ещё у Вас применяется rng.Row, ато я не доглядел и ещё могу проглядеть...
combat, потому что он не знает что такое roww (чему оно равно), либо выходит та же ситуация что и в ListBox_Change() после введения текста в ТехtBox1. Можете мне сразу написать где ещё у Вас применяется rng.Row, ато я не доглядел и ещё могу проглядеть...Roman777
Да вроде все больше нигде, сейчас Вы стали делать Коментарии, буду разбираться, а так понимание принципа работы поиска испытываю трудности поэтому еще продолжаю мучать Вас
Да вроде все больше нигде, сейчас Вы стали делать Коментарии, буду разбираться, а так понимание принципа работы поиска испытываю трудности поэтому еще продолжаю мучать Васcombat
еще нашел , то если используем поиск через текстбокс в лист боксе высвечивается правильно, а в верхнем индикаторе др. и в форму попадает др. СИ
вот тут я не понял, по подробней опишите, где чё пропало, у меня вродебы всё меняется как должно. Проверьте это:
[vba]
Код
Option Explicit ' Dim SRng As Range ', InRng As Range Dim roww As Long Dim F As Integer Dim rng As Range Dim Vs(), SArr() As String, Sentence As String Dim R As Long, N As Long, Txt As String Dim sekret As Single ' Private Sub CommandButton1_Click() 'Отмена' Unload Me 'Закрыть форму End Sub ' Private Sub CommandButton2_Click() 'OK' R = ListBox1.List(ListBox1.ListIndex, 0) Worksheets("РСИ").Cells(3, 55) = Lbl.Caption Unload Me End Sub ' Private Sub ListBox1_Enter() If ListBox1.ListCount > 0 Then If ListBox1.ListIndex = -1 Then ListBox1.ListIndex = 0 End If
End Sub ' Private Sub TextBox1_Change() Dim Txt As String, K As Long ' Txt = " " & Trim(TextBox1.Text) F = 1 ' задаём условие, что при выполнении ТекстБокса F=1 ListBox1.Clear For R = 1 To N Sentence = SArr(R) If InStr(1, Sentence, Txt, vbTextCompare) > 0 Then ListBox1.AddItem R ListBox1.List(K, 1) = Vs(R, 1) K = K + 1 End If Next roww = ListBox1.ListIndex + 1 F = 0 ' задаём условие, что после отработки ТекстБокса F=0 - потому что вы потом будете тыкать в _ ЛистБокс, а там своё условие, что переменная roww будет переназначена только при F=0 CommandButton2.Enabled = False End Sub ' Private Sub UserForm_Initialize() ListBox1.ColumnCount = 2 ' ListBox1.ColumnWidths = "0;" CommandButton2.Enabled = False '........................................... Set SRng = Sheets("БазаСИ").Range("B1") 'первая ячейка списка' '........................................... Set SRng = Range(SRng, SRng.End(xlDown)) N = SRng.Rows.Count Vs = SRng.Value ReDim SArr(1 To N) For R = 1 To N Sentence = Vs(R, 1) SArr(R) = " " & Replace(Sentence, """", "") ListBox1.AddItem R ListBox1.List(R - 1, 1) = Sentence Next Lbl_SI.Caption = "Всего СИ в базе" & " " & N & " ед." End Sub Private Sub ListBox1_Change() If F <> 1 Then roww = UserForm2.ListBox1.ListIndex + 1 End If Lbl.Caption = Worksheets("БазаСИ").Cells(roww, 1).Value & " " & Worksheets("БазаСИ").Cells(roww, 2).Value _ & ", рег № " & Worksheets("БазаСИ").Cells(roww, 4).Value ' Наименование и тип СИ, рег № Lbl_Periud.Caption = Worksheets("БазаСИ").Cells(roww, 3).Value ' периодичность поверки DTPicker1.Enabled = True Lbl_mec.Visible = True LblDate2.Visible = True Lbl_NTD.Caption = Worksheets("БазаСИ").Cells(roww, 5).Value ' методика поверки ActiveSheet.Cells(28, 20) = Lbl_NTD.Caption T1.Text = Worksheets("БазаСИ").Cells(roww, 6).Value ' Используемые эталоны Worksheets("Обр").Cells(9, 1) = T1.Text End Sub
'Календарь ========================================================= Private Sub DTPicker1_Change() Dim Date0 As Date, Date1 As Date ListBox1.Enabled = False CommandButton3.Enabled = True
ActiveSheet.Cells(49, 2) = DTPicker1.Value Date0 = DTPicker1.Value ' Дата поверки Date1 = DateAdd("m", Lbl_Periud.Caption, Date0) LblDate2.Caption = Date1 ActiveSheet.Cells(13, 38) = Date1 CommandButton2.Enabled = LblDate2.Caption = Date1 End Sub
'Используемые эталоны ============================================================= Private Sub CommandButton3_Click() T11.Text = T1.Text T11.Visible = True End Sub
Private Sub CommandButton4_Click() T11.Visible = False Worksheets("Обр").Cells(9, 1) = T1.Text End Sub Private Sub T11_Change() If F <> 1 Then roww = UserForm2.ListBox1.ListIndex + 1 End If Worksheets("БазаСИ").Cells(roww, 6).Value = T11.Text T1.Text = T11.Text End Sub
еще нашел , то если используем поиск через текстбокс в лист боксе высвечивается правильно, а в верхнем индикаторе др. и в форму попадает др. СИ
вот тут я не понял, по подробней опишите, где чё пропало, у меня вродебы всё меняется как должно. Проверьте это:
[vba]
Код
Option Explicit ' Dim SRng As Range ', InRng As Range Dim roww As Long Dim F As Integer Dim rng As Range Dim Vs(), SArr() As String, Sentence As String Dim R As Long, N As Long, Txt As String Dim sekret As Single ' Private Sub CommandButton1_Click() 'Отмена' Unload Me 'Закрыть форму End Sub ' Private Sub CommandButton2_Click() 'OK' R = ListBox1.List(ListBox1.ListIndex, 0) Worksheets("РСИ").Cells(3, 55) = Lbl.Caption Unload Me End Sub ' Private Sub ListBox1_Enter() If ListBox1.ListCount > 0 Then If ListBox1.ListIndex = -1 Then ListBox1.ListIndex = 0 End If
End Sub ' Private Sub TextBox1_Change() Dim Txt As String, K As Long ' Txt = " " & Trim(TextBox1.Text) F = 1 ' задаём условие, что при выполнении ТекстБокса F=1 ListBox1.Clear For R = 1 To N Sentence = SArr(R) If InStr(1, Sentence, Txt, vbTextCompare) > 0 Then ListBox1.AddItem R ListBox1.List(K, 1) = Vs(R, 1) K = K + 1 End If Next roww = ListBox1.ListIndex + 1 F = 0 ' задаём условие, что после отработки ТекстБокса F=0 - потому что вы потом будете тыкать в _ ЛистБокс, а там своё условие, что переменная roww будет переназначена только при F=0 CommandButton2.Enabled = False End Sub ' Private Sub UserForm_Initialize() ListBox1.ColumnCount = 2 ' ListBox1.ColumnWidths = "0;" CommandButton2.Enabled = False '........................................... Set SRng = Sheets("БазаСИ").Range("B1") 'первая ячейка списка' '........................................... Set SRng = Range(SRng, SRng.End(xlDown)) N = SRng.Rows.Count Vs = SRng.Value ReDim SArr(1 To N) For R = 1 To N Sentence = Vs(R, 1) SArr(R) = " " & Replace(Sentence, """", "") ListBox1.AddItem R ListBox1.List(R - 1, 1) = Sentence Next Lbl_SI.Caption = "Всего СИ в базе" & " " & N & " ед." End Sub Private Sub ListBox1_Change() If F <> 1 Then roww = UserForm2.ListBox1.ListIndex + 1 End If Lbl.Caption = Worksheets("БазаСИ").Cells(roww, 1).Value & " " & Worksheets("БазаСИ").Cells(roww, 2).Value _ & ", рег № " & Worksheets("БазаСИ").Cells(roww, 4).Value ' Наименование и тип СИ, рег № Lbl_Periud.Caption = Worksheets("БазаСИ").Cells(roww, 3).Value ' периодичность поверки DTPicker1.Enabled = True Lbl_mec.Visible = True LblDate2.Visible = True Lbl_NTD.Caption = Worksheets("БазаСИ").Cells(roww, 5).Value ' методика поверки ActiveSheet.Cells(28, 20) = Lbl_NTD.Caption T1.Text = Worksheets("БазаСИ").Cells(roww, 6).Value ' Используемые эталоны Worksheets("Обр").Cells(9, 1) = T1.Text End Sub
'Календарь ========================================================= Private Sub DTPicker1_Change() Dim Date0 As Date, Date1 As Date ListBox1.Enabled = False CommandButton3.Enabled = True
ActiveSheet.Cells(49, 2) = DTPicker1.Value Date0 = DTPicker1.Value ' Дата поверки Date1 = DateAdd("m", Lbl_Periud.Caption, Date0) LblDate2.Caption = Date1 ActiveSheet.Cells(13, 38) = Date1 CommandButton2.Enabled = LblDate2.Caption = Date1 End Sub
'Используемые эталоны ============================================================= Private Sub CommandButton3_Click() T11.Text = T1.Text T11.Visible = True End Sub
Private Sub CommandButton4_Click() T11.Visible = False Worksheets("Обр").Cells(9, 1) = T1.Text End Sub Private Sub T11_Change() If F <> 1 Then roww = UserForm2.ListBox1.ListIndex + 1 End If Worksheets("БазаСИ").Cells(roww, 6).Value = T11.Text T1.Text = T11.Text End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
