Добрый вечер. Есть таблица учета выписанных счетов. На основании выписанного счета нужно оформить реализацию товара Проблема в том что есть счета в которых выписано несколько товаров. При выборе № счета в комбобоксе отображается номера двух счетов . Если выбирать значения в комбе ,то отображаются данные по первому товару, а КАК ОТОБРАЗИТЬ второй товар . (товаров бывает до 4 наименований в одном счете.)
Добрый вечер. Есть таблица учета выписанных счетов. На основании выписанного счета нужно оформить реализацию товара Проблема в том что есть счета в которых выписано несколько товаров. При выборе № счета в комбобоксе отображается номера двух счетов . Если выбирать значения в комбе ,то отображаются данные по первому товару, а КАК ОТОБРАЗИТЬ второй товар . (товаров бывает до 4 наименований в одном счете.)parovoznik
Kuzmich, доброе утро. признака нет. есть покупатель выбрали- далее список в нем отображается номер счета- выбрали и полях текстбоксов подтянулись данные. а если в в списке номеров счета есть два одинаковых счета и должны подтягиваться соответствующие данные, а подтягивается по первому значению.
Kuzmich, доброе утро. признака нет. есть покупатель выбрали- далее список в нем отображается номер счета- выбрали и полях текстбоксов подтянулись данные. а если в в списке номеров счета есть два одинаковых счета и должны подтягиваться соответствующие данные, а подтягивается по первому значению.parovoznik
Private Sub cmb_НомерСчета_Change() Dim Rng As Range, Invoice As String Dim FAdr As String Me.txt_ВесОтгрузки = "": Me.txt_Номенклатура = "": Me.txt_Поставщик = "" Invoice = Me.cmb_НомерСчета With Sheets("Счет") Set Rng = .Columns(6).Find(what:=Invoice, LookIn:=xlValues, lookAt:=xlWhole) If Not Rng Is Nothing Then FAdr = Rng.Address Do Me.txt_ВесОтгрузки = Me.txt_ВесОтгрузки & Rng.Offset(0, 1) & ", " Me.txt_Номенклатура = Me.txt_Номенклатура & Rng.Offset(0, -3) & ", " Me.txt_Поставщик = Me.txt_Поставщик & Rng.Offset(0, -5) & ", " Set Rng = .Columns(6).FindNext(Rng) Loop While Rng.Address <> FAdr End If End With End Sub
[/vba]
Попробуйте так [vba]
Код
Private Sub cmb_НомерСчета_Change() Dim Rng As Range, Invoice As String Dim FAdr As String Me.txt_ВесОтгрузки = "": Me.txt_Номенклатура = "": Me.txt_Поставщик = "" Invoice = Me.cmb_НомерСчета With Sheets("Счет") Set Rng = .Columns(6).Find(what:=Invoice, LookIn:=xlValues, lookAt:=xlWhole) If Not Rng Is Nothing Then FAdr = Rng.Address Do Me.txt_ВесОтгрузки = Me.txt_ВесОтгрузки & Rng.Offset(0, 1) & ", " Me.txt_Номенклатура = Me.txt_Номенклатура & Rng.Offset(0, -3) & ", " Me.txt_Поставщик = Me.txt_Поставщик & Rng.Offset(0, -5) & ", " Set Rng = .Columns(6).FindNext(Rng) Loop While Rng.Address <> FAdr End If End With End Sub
Kuzmich, это не все данные на форме. простоя их не отображал, а отобразил те элементы ,где была проблемы. может я выбрал не самый лучший вариант,выбора , но другого не знаю.
Kuzmich, это не все данные на форме. простоя их не отображал, а отобразил те элементы ,где была проблемы. может я выбрал не самый лучший вариант,выбора , но другого не знаю.parovoznik
Private Sub CommandButton4_Click() On Error Resume Next Application.ScreenUpdating = False 'выключили обновление экрана ' проверка на заполнение полей Dim X As Control Dim n As Integer Dim i As Integer For Each X In Me.Controls If TypeOf X Is MSForms.TextBox Or TypeOf X Is MSForms.ComboBox Then If X.Value = "" Then MsgBox "Все обязательные поля должны быть заполнены!", 48, "Сообщение" Exit Sub End If End If Next With Sheets("Счет") Dim Rng As Range Dim FAdr As String Dim Rlz As Worksheet n = WorksheetFunction.CountIf(.Range("F4:F" & .Cells(.Rows.Count, "F").End(xlUp).Row), Me.cmb_НомерСчета) Set Rlz = ThisWorkbook.Sheets("Реализация") 'перенос данных с формы на лист
Set Rng = .Columns(6).Find(what:=Me.cmb_НомерСчета, LookIn:=xlValues, lookAt:=xlWhole) If Not Rng Is Nothing Then FAdr = Rng.Address Do Me.txt_ВесОтгрузки = Rng.Offset(0, 1) Me.txt_Номенклатура = Rng.Offset(0, -3) Me.txt_Поставщик = Rng.Offset(0, -5) LastRow = Rlz.Cells(Rlz.Rows.Count, 1).End(xlUp).Row Rlz.Cells(LastRow + 1, 1) = Me.txt_ДатаОтгрузки Rlz.Cells(LastRow + 1, 2) = Me.txt_Поставщик Rlz.Cells(LastRow + 1, 3) = Me.Cmb_СкладОтгрузки Rlz.Cells(LastRow + 1, 4) = Me.txt_Номенклатура Rlz.Cells(LastRow + 1, 5) = Me.Cmb_Покупатель Rlz.Cells(LastRow + 1, 6) = CDbl(Me.txt_ВесОтгрузки) Rlz.Cells(LastRow + 1, 7) = Me.cmb_НомерСчета Set Rng = .Columns(6).FindNext(Rng) Loop While Rng.Address <> FAdr End If
' форматирование таблицы Range(.Cells(4, 1), .Cells(LastRow + 1, 7)).Borders.LineStyle = xlContinuous ' обрамление ячеек End With
Лист2.Activate Unload Me Application.ScreenUpdating = True 'включили обновление экрана End Sub
[/vba]
Цитата
Я добавил кнопку переноса с формы на лист
[vba]
Код
Private Sub CommandButton4_Click() On Error Resume Next Application.ScreenUpdating = False 'выключили обновление экрана ' проверка на заполнение полей Dim X As Control Dim n As Integer Dim i As Integer For Each X In Me.Controls If TypeOf X Is MSForms.TextBox Or TypeOf X Is MSForms.ComboBox Then If X.Value = "" Then MsgBox "Все обязательные поля должны быть заполнены!", 48, "Сообщение" Exit Sub End If End If Next With Sheets("Счет") Dim Rng As Range Dim FAdr As String Dim Rlz As Worksheet n = WorksheetFunction.CountIf(.Range("F4:F" & .Cells(.Rows.Count, "F").End(xlUp).Row), Me.cmb_НомерСчета) Set Rlz = ThisWorkbook.Sheets("Реализация") 'перенос данных с формы на лист
Set Rng = .Columns(6).Find(what:=Me.cmb_НомерСчета, LookIn:=xlValues, lookAt:=xlWhole) If Not Rng Is Nothing Then FAdr = Rng.Address Do Me.txt_ВесОтгрузки = Rng.Offset(0, 1) Me.txt_Номенклатура = Rng.Offset(0, -3) Me.txt_Поставщик = Rng.Offset(0, -5) LastRow = Rlz.Cells(Rlz.Rows.Count, 1).End(xlUp).Row Rlz.Cells(LastRow + 1, 1) = Me.txt_ДатаОтгрузки Rlz.Cells(LastRow + 1, 2) = Me.txt_Поставщик Rlz.Cells(LastRow + 1, 3) = Me.Cmb_СкладОтгрузки Rlz.Cells(LastRow + 1, 4) = Me.txt_Номенклатура Rlz.Cells(LastRow + 1, 5) = Me.Cmb_Покупатель Rlz.Cells(LastRow + 1, 6) = CDbl(Me.txt_ВесОтгрузки) Rlz.Cells(LastRow + 1, 7) = Me.cmb_НомерСчета Set Rng = .Columns(6).FindNext(Rng) Loop While Rng.Address <> FAdr End If
' форматирование таблицы Range(.Cells(4, 1), .Cells(LastRow + 1, 7)).Borders.LineStyle = xlContinuous ' обрамление ячеек End With
Лист2.Activate Unload Me Application.ScreenUpdating = True 'включили обновление экрана End Sub
Kuzmich, благодарю. Протестировал и есть вопросы :-границы не выделяются(обрамление ячеек) и там где товара два по одному счету можно подкорректировать, что бы можно было выбирать один товар. Бывает часто Покупатель выписал два наименования , а отгружает частями. Одну позицию СЕГОДНЯ вторую позже.
Kuzmich, благодарю. Протестировал и есть вопросы :-границы не выделяются(обрамление ячеек) и там где товара два по одному счету можно подкорректировать, что бы можно было выбирать один товар. Бывает часто Покупатель выписал два наименования , а отгружает частями. Одну позицию СЕГОДНЯ вторую позже.parovoznik
можно подкорректировать, что бы можно было выбирать один товар
Попробуйте так [vba]
Код
Private Sub CommandButton4_Click() On Error Resume Next Application.ScreenUpdating = False 'выключили обновление экрана ' проверка на заполнение полей Dim X As Control Dim n As Integer Dim i As Integer Dim reply As Integer For Each X In Me.Controls If TypeOf X Is MSForms.TextBox Or TypeOf X Is MSForms.ComboBox Then If X.Value = "" Then MsgBox "Все обязательные поля должны быть заполнены!", 48, "Сообщение" Exit Sub End If End If Next With Sheets("Счет") Dim Rng As Range Dim FAdr As String Dim Rlz As Worksheet n = WorksheetFunction.CountIf(.Range("F4:F" & .Cells(.Rows.Count, "F").End(xlUp).Row), Me.cmb_НомерСчета) Set Rlz = ThisWorkbook.Sheets("Реализация") 'перенос данных с формы на лист
Set Rng = .Columns(6).Find(what:=Me.cmb_НомерСчета, LookIn:=xlValues, lookAt:=xlWhole) If Not Rng Is Nothing Then FAdr = Rng.Address reply = Application.InputBox("Введите порядковый номер счета для вывода на лист Реализация", Type:=1) i = 1 Do If i = reply Then Me.txt_ВесОтгрузки = Rng.Offset(0, 1) Me.txt_Номенклатура = Rng.Offset(0, -3) Me.txt_Поставщик = Rng.Offset(0, -5) LastRow = Rlz.Cells(Rlz.Rows.Count, 1).End(xlUp).Row Rlz.Cells(LastRow + 1, 1) = Me.txt_ДатаОтгрузки Rlz.Cells(LastRow + 1, 2) = Me.txt_Поставщик Rlz.Cells(LastRow + 1, 3) = Me.Cmb_СкладОтгрузки Rlz.Cells(LastRow + 1, 4) = Me.txt_Номенклатура Rlz.Cells(LastRow + 1, 5) = Me.Cmb_Покупатель Rlz.Cells(LastRow + 1, 6) = CDbl(Me.txt_ВесОтгрузки) Rlz.Cells(LastRow + 1, 7) = Me.cmb_НомерСчета Exit Do End If Set Rng = .Columns(6).FindNext(Rng) i = i + 1 Loop While Rng.Address <> FAdr End If ' форматирование таблицы Range(Rlz.Cells(4, 1), Rlz.Cells(LastRow + 1, 7)).Borders.LineStyle = xlContinuous ' обрамление ячеек End With Лист2.Activate Unload Me Application.ScreenUpdating = True 'включили обновление экрана End Sub
[/vba] Возможно надо будет ввести проверку, чтобы порядковый номер счета не превышал количество значений таких счетов. Удачи!
Цитата
можно подкорректировать, что бы можно было выбирать один товар
Попробуйте так [vba]
Код
Private Sub CommandButton4_Click() On Error Resume Next Application.ScreenUpdating = False 'выключили обновление экрана ' проверка на заполнение полей Dim X As Control Dim n As Integer Dim i As Integer Dim reply As Integer For Each X In Me.Controls If TypeOf X Is MSForms.TextBox Or TypeOf X Is MSForms.ComboBox Then If X.Value = "" Then MsgBox "Все обязательные поля должны быть заполнены!", 48, "Сообщение" Exit Sub End If End If Next With Sheets("Счет") Dim Rng As Range Dim FAdr As String Dim Rlz As Worksheet n = WorksheetFunction.CountIf(.Range("F4:F" & .Cells(.Rows.Count, "F").End(xlUp).Row), Me.cmb_НомерСчета) Set Rlz = ThisWorkbook.Sheets("Реализация") 'перенос данных с формы на лист
Set Rng = .Columns(6).Find(what:=Me.cmb_НомерСчета, LookIn:=xlValues, lookAt:=xlWhole) If Not Rng Is Nothing Then FAdr = Rng.Address reply = Application.InputBox("Введите порядковый номер счета для вывода на лист Реализация", Type:=1) i = 1 Do If i = reply Then Me.txt_ВесОтгрузки = Rng.Offset(0, 1) Me.txt_Номенклатура = Rng.Offset(0, -3) Me.txt_Поставщик = Rng.Offset(0, -5) LastRow = Rlz.Cells(Rlz.Rows.Count, 1).End(xlUp).Row Rlz.Cells(LastRow + 1, 1) = Me.txt_ДатаОтгрузки Rlz.Cells(LastRow + 1, 2) = Me.txt_Поставщик Rlz.Cells(LastRow + 1, 3) = Me.Cmb_СкладОтгрузки Rlz.Cells(LastRow + 1, 4) = Me.txt_Номенклатура Rlz.Cells(LastRow + 1, 5) = Me.Cmb_Покупатель Rlz.Cells(LastRow + 1, 6) = CDbl(Me.txt_ВесОтгрузки) Rlz.Cells(LastRow + 1, 7) = Me.cmb_НомерСчета Exit Do End If Set Rng = .Columns(6).FindNext(Rng) i = i + 1 Loop While Rng.Address <> FAdr End If ' форматирование таблицы Range(Rlz.Cells(4, 1), Rlz.Cells(LastRow + 1, 7)).Borders.LineStyle = xlContinuous ' обрамление ячеек End With Лист2.Activate Unload Me Application.ScreenUpdating = True 'включили обновление экрана End Sub
[/vba] Возможно надо будет ввести проверку, чтобы порядковый номер счета не превышал количество значений таких счетов. Удачи!Kuzmich
В окошко со счетом добавил второй столбец с номером строки, в которой этот счет встречается. Выбираете нужную вам строку, при нажатии на ОК эта строка добавляется на лист Реализация
Цитата
есть счета в которых выписано несколько товаров
В окошко со счетом добавил второй столбец с номером строки, в которой этот счет встречается. Выбираете нужную вам строку, при нажатии на ОК эта строка добавляется на лист РеализацияKuzmich
Kuzmich, Доброго Времени Суток! Ради спортивного интереса, если на форму добавить ещё один TextBox чтоб он выводил Номер строки выбранного Счёта. Помогите Пожалуйста код допилить. Спасибо! И Извините что влез не в свою тему.
Kuzmich, Доброго Времени Суток! Ради спортивного интереса, если на форму добавить ещё один TextBox чтоб он выводил Номер строки выбранного Счёта. Помогите Пожалуйста код допилить. Спасибо! И Извините что влез не в свою тему.MikeVol