Автозаполнение листа с формы с индекс-ным поиском по первым - Страница 2

Старая форма входа

Страница 2 из 2 « 1 2
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Автозаполнение листа с формы с индекс-ным поиском по первым (Макросы/Sub)

Автозаполнение листа с формы с индекс-ным поиском по первым

combat

Дата: Вторник, 29.09.2015, 14:11 | Сообщение № 21

Группа: Пользователи

Ранг: Участник

Сообщений: 50

Репутация: 0 ±

Замечаний: 20% ±

Excel 2010

а пришлите полностью файл который работает

Ответить

Roman777

Дата: Вторник, 29.09.2015, 14:26 | Сообщение № 22

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Вот файлик, вроде тыкаю туда-сюда и редактирую-сохраняю... всё работает.

К сообщению приложен файл: __97-2003_1_.7z (85.6 Kb)

Много чего не знаю!!!!

Ответить

combat

Дата: Вторник, 29.09.2015, 14:35 | Сообщение № 23

Группа: Пользователи

Ранг: Участник

Сообщений: 50

Репутация: 0 ±

Замечаний: 20% ±

Excel 2010

а ну у вас тоже самое, вот смотрите, допустим в поиске выберем осциллограф, отечественные у нас начинаются с С1-, что и наберите в техкстбоксе и и выделе те из списка любой допустим с1-101, а выходит Толщиномеры ультразвуковые 25, рег № 29754-05 , вот где проблема

Ответить

Roman777

Дата: Вторник, 29.09.2015, 15:13 | Сообщение № 24

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

combat, блин, глянул ещё раз код, фигни Вам насоветовал. Получается что listindex я беру не в те моменты. Смотрите поставьте так красную точку (она назначает остонов выполнения программы, далее будем смотреть пошагово (чтобы перейти на следующий шак надо будет нажимать F8).

Далее запускаете форму по клику на "Заполнить свидетельтсво"
ставите в поиск по буквам курсор и вводите символ. В момент изменения содержания данного поля, срабатывает условие TextBox1_Change()
на том месте, где поставили красную точку код приостановился... далее жмём F8 и каждый шаг это F8. Видно, что у Вас при очищении:
[vba]

Код

ListBox1.Clear

[/vba]
Содержимое листбокса меняется - соответственно сразу же срабатывает Listbox1_Change()
Вот Вам этого не нужно, поэтому, на самом деле тут первое изменение, а именно [vba]

Код

roww = UserForm2.Listbox1.ListIndex+1

[/vba] без всяких добавлений условий было правильно. Всего на всего надо в момент срабатывания TextBox1_Change() заставить программу не срабатывать на ListBox1_Change(). Единственный ньюанс, я пока не знаю как это сделать... уже попробовал List.Enable=false и Application.EnableEvents=False... чтото это не помогает. Мне пока что это странно...)
не пойму почему рисунок не отображается (ссылка с гуглоблака)... прикреплю файлом.

Код

ListBox1.Clear

Код

roww = UserForm2.Listbox1.ListIndex+1

К сообщению приложен файл: 4085755.rar (8.7 Kb)

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Вторник, 29.09.2015, 15:19

Ответить

Сообщениеcombat, блин, глянул ещё раз код, фигни Вам насоветовал. Получается что listindex я беру не в те моменты. Смотрите поставьте так красную точку (она назначает остонов выполнения программы, далее будем смотреть пошагово (чтобы перейти на следующий шак надо будет нажимать F8).

Код

ListBox1.Clear

Код

roww = UserForm2.Listbox1.ListIndex+1

Автор - Roman777
Дата добавления - 29.09.2015 в 15:13

combat

Дата: Вторник, 29.09.2015, 15:26 | Сообщение № 25

Группа: Пользователи

Ранг: Участник

Сообщений: 50

Репутация: 0 ±

Замечаний: 20% ±

Excel 2010

Мне один опытный программист посоветовал:

Собственно, в Вашем примере этот трюк уже реализован - только вместо того, чтобы заполнять
первый столбец бессмысленным счётчиком, Вы можете загружать в него данные столбца F, а затем,
по мере необходимости, получать данные этого столбца используя свойство .ListIndex

А вот как это реализовать? .... может Вас натолкнет на мысль, только не понятно данные столбца F это перечень эталонов

Ответить

Roman777

Дата: Вторник, 29.09.2015, 15:26 | Сообщение № 26

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

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
      CommandButton2.Enabled = False
      F = 0
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 Exit Sub
          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
      F = 0
      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()
      roww = UserForm2.ListBox1.ListIndex + 1
      Worksheets("БазаСИ").Cells(roww, 6).Value = T11.Text
      T1.Text = T11.Text
End Sub

[/vba]

Не дождался Вашего вопроса, но в общем так тоже работает.

combat,

[vba]

Код

[/vba]

Не дождался Вашего вопроса, но в общем так тоже работает.Roman777

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Вторник, 29.09.2015, 15:27

Ответить

Сообщениеcombat,

[vba]

Код

[/vba]

Не дождался Вашего вопроса, но в общем так тоже работает.

Автор - Roman777
Дата добавления - 29.09.2015 в 15:26

Roman777

Дата: Вторник, 29.09.2015, 15:33 | Сообщение № 27

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

А собственно про совет Вашего программиста. Он очень похож на моё раннее предложение. В котором я Вам предлагал добавить массив Arrr(). Думаю что-то такое он и имел в Виду. В массив записывается положение row. А далее выгружается уже в событии ListBox1_Change(). Но В вашем случае это не нужно, поскольку у Вас положение row (строки на листе БАЗАСИ) численно равно положению Индекса строки в листбоксе + 1. А все проблемы возникали только из-за того, что у Вас при срабатывании ТекстБокс1 - происходило очищение Листбокса, которое влекло на срабатывание Listbox1_Change() а тут Вам этого не было нужно) поэтому я добавил условие на выход из ListBox1_Change() пока выполняется операция ТекстБокс1_Change()

Хотя смотрю, проблема осталась... ещё погляжу чуть позже...)
Глянул, всё же без массива тут не обойтись) поскольку Listindex для нового Lisbox1 (который собран по выбранным символам в ТехтBox1) будет уже отличаться от положения строки в БазаСи.

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Вторник, 29.09.2015, 15:38

Ответить

Roman777

Дата: Вторник, 29.09.2015, 15:54 | Сообщение № 28

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

combat,
Проверьте вот такой вариант:

[vba]

Код

Option Explicit
'
Dim SRng As Range ', InRng As Range
Dim roww As Long
Dim Arrr() 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)
             Arrr(K) = R
             K = K + 1
         End If
     Next
     CommandButton2.Enabled = False
     F = 0
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)
     ReDim Arrr(N - 1)
     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
     Lbl_SI.Caption = "Всего СИ в базе" & " " & N & " ед."
End Sub
     Private Sub ListBox1_Change()
     If F = 1 Then Exit Sub
         roww = Arrr(UserForm2.ListBox1.ListIndex)
     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
     F = 0
     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()
     roww = Arrr(UserForm2.ListBox1.ListIndex)
     Worksheets("БазаСИ").Cells(roww, 6).Value = T11.Text
     T1.Text = T11.Text
End Sub

[/vba]

combat,
Проверьте вот такой вариант:

[vba]

Код

[/vba]

Roman777

Много чего не знаю!!!!

Ответить

Сообщениеcombat,
Проверьте вот такой вариант:

[vba]

Код

[/vba]

Автор - Roman777
Дата добавления - 29.09.2015 в 15:54

combat

Дата: Вторник, 29.09.2015, 16:38 | Сообщение № 29

Группа: Пользователи

Ранг: Участник

Сообщений: 50

Репутация: 0 ±

Замечаний: 20% ±

Excel 2010

вот теперь, усё, работает как надо
еще вопросик как моему календарю присвоить дату сегодня в форме, как в экселе =СЕГОДНЯ(), или =Now() в акцессе, существует такая переменная?

Ответить

Roman777

Дата: Вторник, 29.09.2015, 16:59 | Сообщение № 30

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

combat,
Попробуйте так:
'
[vba]

Код

Private Sub UserForm_Initialize()
     DTPicker1.Value = Format(Now(), "d.m.yyyy") ' добавляем сегодняшнюю дату при инициализации формы
     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

[/vba]

Много чего не знаю!!!!

Ответить

combat

Дата: Вторник, 29.09.2015, 17:20 | Сообщение № 31

Группа: Пользователи

Ранг: Участник

Сообщений: 50

Репутация: 0 ±

Замечаний: 20% ±

Excel 2010

Да очень просто, буду теперь знать

Ответить

Страница 2 из 2
«
1
2