здравствуйте, подскажите пожалуйста после того как вводим год 2013 все выводит, но когда мы вводим 1999, а из 2 записи, в некоторых столбцах остается предыдущая запись, как это убрать?
здравствуйте, подскажите пожалуйста после того как вводим год 2013 все выводит, но когда мы вводим 1999, а из 2 записи, в некоторых столбцах остается предыдущая запись, как это убрать?DKeT
Sub Кнопка2_Щелчок() Dim ILastrow As Long, Jlastrow As Long, I As Integer, J As Integer, God As String God = InputBox("Введите год!", "") If Not IsNumeric(God) Then GoTo A If God < 1900 Or God > 2099 Then GoTo A With Sheets(1) 'работаем с листом исходных данных ILastrow = .Cells(Rows.Count, 1).End(xlUp).Row ' сколько трок занято в 1 колонке Sheets(2).Select 'работаем с листом приёма данных Jlastrow = Cells(Rows.Count, 1).End(xlUp).Row + 1 ' сколько трок занято в 1 колонке If Jlastrow > 3 Then Rows("4:" & Jlastrow).ClearContents ' если есть занятые строки - чистим
Jlastrow = 3 For I = 3 To ILastrow ' идём по исходным If InStr(1, .Cells(I, 5), God) > 0 Then ' если есть год Jlastrow = Jlastrow + 1 ' первая пустая .Range("A" & I & ":H" & I).Copy Destination:=Range("A" & Jlastrow) End If Next End With Exit Sub A: MsgBox "Фигня какая-то" End Sub
Sub Кнопка2_Щелчок() Dim ILastrow As Long, Jlastrow As Long, I As Integer, J As Integer, God As String God = InputBox("Введите год!", "") If Not IsNumeric(God) Then GoTo A If God < 1900 Or God > 2099 Then GoTo A With Sheets(1) 'работаем с листом исходных данных ILastrow = .Cells(Rows.Count, 1).End(xlUp).Row ' сколько трок занято в 1 колонке Sheets(2).Select 'работаем с листом приёма данных Jlastrow = Cells(Rows.Count, 1).End(xlUp).Row + 1 ' сколько трок занято в 1 колонке If Jlastrow > 3 Then Rows("4:" & Jlastrow).ClearContents ' если есть занятые строки - чистим
Jlastrow = 3 For I = 3 To ILastrow ' идём по исходным If InStr(1, .Cells(I, 5), God) > 0 Then ' если есть год Jlastrow = Jlastrow + 1 ' первая пустая .Range("A" & I & ":H" & I).Copy Destination:=Range("A" & Jlastrow) End If Next End With Exit Sub A: MsgBox "Фигня какая-то" End Sub
K-SerJC, вроде да, скажите пожалуйста , а если мне нужно чтоб он выдавал все записи до 37 столбца я тут должна указать ? If Jlastrow > 3 Then Rows("4:" & Jlastrow).ClearContents ' если есть занятые строки - чистим
все поняла, поменять вот тут :[vba]
Код
.Range("A" & I & ":H" & I).Copy Destination:=Range("A" & Jlastrow)
K-SerJC, вроде да, скажите пожалуйста , а если мне нужно чтоб он выдавал все записи до 37 столбца я тут должна указать ? If Jlastrow > 3 Then Rows("4:" & Jlastrow).ClearContents ' если есть занятые строки - чистим
все поняла, поменять вот тут :[vba]
Код
.Range("A" & I & ":H" & I).Copy Destination:=Range("A" & Jlastrow)