Добрый день, добрым людям! Нужна подмога! Хочу сделать такую кнопочку, при нажатии которой, данные переносились в нужную ячейку в зависимости от заданной даты. Например, ставлю дату "5 января 2016", ставлю в строку топливо "100", нажимаю кнопку и БАЦ!, во вкладке "БАЗА" появляется в нужном месте "100"
Добрый день, добрым людям! Нужна подмога! Хочу сделать такую кнопочку, при нажатии которой, данные переносились в нужную ячейку в зависимости от заданной даты. Например, ставлю дату "5 января 2016", ставлю в строку топливо "100", нажимаю кнопку и БАЦ!, во вкладке "БАЗА" появляется в нужном месте "100" Дми3й
Private Sub CommandButton1_Click() Dim i&, d As Range Set d = BD.Columns(1).Find([C3]) If d Is Nothing Then MsgBox "Дата " & [C3] & " не найдена в базе данных.", vbExclamation: Exit Sub With [C6:C9] For i = 1 To .Rows.Count If Len(.Cells(i, 1)) Then d.Offset(, i) = .Cells(i, 1) Next End With End Sub
[/vba]
Например, так:[vba]
Код
Private Sub CommandButton1_Click() Dim i&, d As Range Set d = BD.Columns(1).Find([C3]) If d Is Nothing Then MsgBox "Дата " & [C3] & " не найдена в базе данных.", vbExclamation: Exit Sub With [C6:C9] For i = 1 To .Rows.Count If Len(.Cells(i, 1)) Then d.Offset(, i) = .Cells(i, 1) Next End With End Sub
Sub trans() If Application.WorksheetFunction.Sum(Range("C6:C9")) = 0 Or [C3] = "" Then Exit Sub With Sheets("ÁÀÇÀ") Dim L As Long: L = .Cells(Rows.Count, 1).End(xlUp).Row + 1 Dim arr: arr = Range("C6:C9").Value arr = Application.WorksheetFunction.Transpose(arr) .Cells(L, 1) = [C3] .Range("B" & L & ":E" & L).Value = arr .Range("A" & L - 1 & ":E" & L - 1).Copy .Range("A" & L & ":E" & L).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End With End Sub
[/vba]
Как-то так (макрос "повесьте" на кнопку) [vba]
Код
Sub trans() If Application.WorksheetFunction.Sum(Range("C6:C9")) = 0 Or [C3] = "" Then Exit Sub With Sheets("ÁÀÇÀ") Dim L As Long: L = .Cells(Rows.Count, 1).End(xlUp).Row + 1 Dim arr: arr = Range("C6:C9").Value arr = Application.WorksheetFunction.Transpose(arr) .Cells(L, 1) = [C3] .Range("B" & L & ":E" & L).Value = arr .Range("A" & L - 1 & ":E" & L - 1).Copy .Range("A" & L & ":E" & L).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End With End Sub
[moder]Не нужно цитировать ВСЕ сообщение. Об этом в Правилах написано.[/moder]
KSV, большое спасибо за помощь! Есть еще небольшая просьба.. Вот, в вашем варианте стоит условие, что если дата не найдена в базе, то выводится сообщение на экран. А можно еще добавить условие, что если поле дата не заполнена вовсе, тогда тоже выводится такое же сообщение? А то он мне так в пустые поля данные пихает. Спасибо.
[moder]Не нужно цитировать ВСЕ сообщение. Об этом в Правилах написано.[/moder]
KSV, большое спасибо за помощь! Есть еще небольшая просьба.. Вот, в вашем варианте стоит условие, что если дата не найдена в базе, то выводится сообщение на экран. А можно еще добавить условие, что если поле дата не заполнена вовсе, тогда тоже выводится такое же сообщение? А то он мне так в пустые поля данные пихает. Спасибо.Дми3й
Сообщение отредактировал _Boroda_ - Вторник, 15.09.2015, 15:01
Private Sub CommandButton1_Click() Dim i&, d As Range If [C3] = "" Then MsgBox "Введите дату в ячейку C3.": Exit Sub Set d = BD.Columns(1).Find([C3]) If d Is Nothing Then MsgBox "Дата " & [C3] & " не найдена в базе данных.", vbExclamation: Exit Sub With [C6:C9] For i = 1 To .Rows.Count If Len(.Cells(i, 1)) Then d.Offset(, i) = .Cells(i, 1) Next End With End Sub
[/vba]
Так 1 строку добавьте: [vba]
Код
Private Sub CommandButton1_Click() Dim i&, d As Range If [C3] = "" Then MsgBox "Введите дату в ячейку C3.": Exit Sub Set d = BD.Columns(1).Find([C3]) If d Is Nothing Then MsgBox "Дата " & [C3] & " не найдена в базе данных.", vbExclamation: Exit Sub With [C6:C9] For i = 1 To .Rows.Count If Len(.Cells(i, 1)) Then d.Offset(, i) = .Cells(i, 1) Next End With End Sub
Всем спасибо за помощь! А я вот еще хотел усложнить задачку. [vba]
Код
Private Sub CommandButton1_Click() Dim i&, d As Range Set d = BD.Columns(1).Find([C3]) If d Is Nothing Then MsgBox "Дата " & [C3] & " не найдена в базе данных.", vbExclamation: Exit Sub With [C6:C9] For i = 1 To .Rows.Count If Len(.Cells(i, 1)) Then d.Offset(, i) = .Cells(i, 1) Next End With End Sub
[/vba] Как изменить этот макрос если у меня не одно условие, а несколько: Так на первом листе у меня список товаров и их количество И, по нажатии на кнопку, количество товара попадает во вкладку "склад", в зависимости от наименования товара.
Всем спасибо за помощь! А я вот еще хотел усложнить задачку. [vba]
Код
Private Sub CommandButton1_Click() Dim i&, d As Range Set d = BD.Columns(1).Find([C3]) If d Is Nothing Then MsgBox "Дата " & [C3] & " не найдена в базе данных.", vbExclamation: Exit Sub With [C6:C9] For i = 1 To .Rows.Count If Len(.Cells(i, 1)) Then d.Offset(, i) = .Cells(i, 1) Next End With End Sub
[/vba] Как изменить этот макрос если у меня не одно условие, а несколько: Так на первом листе у меня список товаров и их количество И, по нажатии на кнопку, количество товара попадает во вкладку "склад", в зависимости от наименования товара. Дми3й
Сайт отличный и много по уже готовым примерам изучил, внедрил и применяю. Спасибо что Вы есть!
Я не совсем понял работу Visual Basic и соответственно не смог применить это к своему случаю. прошу помощи специалистов. А именно мне не понятна работа строки
Цитата
Set d = BD.Columns(1).Find([C3])
BD.Columns(1) – что это и откуда оно в экселе?
В моем случае надо такое...
При нажатии кнопки «СОХРАНИТЬ ДАННЫЕ» на листе «Простои 3см» необходимо занести данные из ячеек I83, J83, K83, N83, O83, P83, S83, T83, U83 в ячейки строк с теми же буквами, но в соответствующую из строк чья дата в ячейках G89:G119 на листе «Данные» равна дате в ячейке (C1-1), т.е. предыдущему числу на листе «Простои 3см»
Пример, если как в документе проставлена дата на листе «Простои 3см» в ячейке «С1» = 10.02.19, то по нажатию кнопки «СОХРАНИТЬ ДАННЫЕ» значения ячеек I83, J83, K83, N83, O83, P83, S83, T83, U83 на листе «Данные» неоходимо занести в соответствующие по буквам ячейки строки с датой 09.02.19, т.е. встроку 97.
Заранее благодарен!
Сайт отличный и много по уже готовым примерам изучил, внедрил и применяю. Спасибо что Вы есть!
Я не совсем понял работу Visual Basic и соответственно не смог применить это к своему случаю. прошу помощи специалистов. А именно мне не понятна работа строки
Цитата
Set d = BD.Columns(1).Find([C3])
BD.Columns(1) – что это и откуда оно в экселе?
В моем случае надо такое...
При нажатии кнопки «СОХРАНИТЬ ДАННЫЕ» на листе «Простои 3см» необходимо занести данные из ячеек I83, J83, K83, N83, O83, P83, S83, T83, U83 в ячейки строк с теми же буквами, но в соответствующую из строк чья дата в ячейках G89:G119 на листе «Данные» равна дате в ячейке (C1-1), т.е. предыдущему числу на листе «Простои 3см»
Пример, если как в документе проставлена дата на листе «Простои 3см» в ячейке «С1» = 10.02.19, то по нажатию кнопки «СОХРАНИТЬ ДАННЫЕ» значения ячеек I83, J83, K83, N83, O83, P83, S83, T83, U83 на листе «Данные» неоходимо занести в соответствующие по буквам ячейки строки с датой 09.02.19, т.е. встроку 97.
Раз модераторы не предупреждают о создание новой темы, наверное вопрос по теме. Хотя под это название может подойти очень много тем этого раздела. Думаю что большинство макросов включается от нажатия кнопки. Вариант такой[vba]
Код
Private Sub CommandButton1_Click() Dim i As Long Application.ScreenUpdating = False On Error GoTo Errors1 i = Application.Match(Sheets("Простои 3см").Range("C1"), Sheets("Данные").Range("G1:G200"), 0) - 1 With Sheets("Данные") .Range("I" & i & ":" & "U" & i) = .Range("I83:U83").Value End With GoTo Ends: Errors1: MsgBox ("В таблице на листе ""Данные"" нет строки с датой " & Format(Sheets("Простои 3см").Range("C1"), "DD MMMM YYYY г.")) Ends: Application.ScreenUpdating = True End Sub
[/vba]
Раз модераторы не предупреждают о создание новой темы, наверное вопрос по теме. Хотя под это название может подойти очень много тем этого раздела. Думаю что большинство макросов включается от нажатия кнопки. Вариант такой[vba]
Код
Private Sub CommandButton1_Click() Dim i As Long Application.ScreenUpdating = False On Error GoTo Errors1 i = Application.Match(Sheets("Простои 3см").Range("C1"), Sheets("Данные").Range("G1:G200"), 0) - 1 With Sheets("Данные") .Range("I" & i & ":" & "U" & i) = .Range("I83:U83").Value End With GoTo Ends: Errors1: MsgBox ("В таблице на листе ""Данные"" нет строки с датой " & Format(Sheets("Простои 3см").Range("C1"), "DD MMMM YYYY г.")) Ends: Application.ScreenUpdating = True End Sub
Я только начал осваивать VBA, пока многое не понимаю, поэтому прошу помочь. За основу взял макрос из этой темы. Мне нужно введенные значения на первом листе по кнопке передать в нужный лист (имя листа значение ячейки B3) в нужную строку (по году и месяцу). Файл с примером прилагаю.
Я только начал осваивать VBA, пока многое не понимаю, поэтому прошу помочь. За основу взял макрос из этой темы. Мне нужно введенные значения на первом листе по кнопке передать в нужный лист (имя листа значение ячейки B3) в нужную строку (по году и месяцу). Файл с примером прилагаю.aleshke