powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите с кодом в Excel
25 сообщений из 34, страница 1 из 2
Помогите с кодом в Excel
    #37444103
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Нужно сделать чтобы в первом столбце проставлялись флажки, при нажатии в ячейке мышкой. А при нажатии кнопки помеченные строчки копировались на 4-ую страницу.
Для пометок я написал следующий код:
'CODE 1 Ставим флажок если был одиночный щелчок по ячейке
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A7:A920")) Is Nothing Then
Target.Font.Name = "Marlett"
If Target = vbNullString Then
Target = "a"
Else
Target = vbNullString
End If
End If

End Sub

'CODE 2 Снимаем флажок если был двойной щелчок по ячейке
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A7:A920")) Is Nothing Then
Cancel = True 'чтобы не уйти в режим редактирования
Target.Font.Name = "Marlett"
If Target = vbNullString Then
Target = "a"
Else
Target = vbNullString
End If
End If
End Sub


а вот с кодом для кнопки постоянно происходят ошибки. Вот он:
Private Sub CommandButton1_Click()
'
'
Application.EnableEvents = False
Sheets("Лист4").Select ' очищаем диапазон от ранее вставленных
Range("A7:D200").Select
Selection.Delete Shift:=xlUp
Sheets("Лист2").Select ' лист с выделениями
Selection.AutoFilter Field:=2, Criteria1:="a"
If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlVisible).Count > 1 Then
Range("A7:D920").Select
Selection.Copy
Sheets("Лист4").Select
Range("A1").Select
ActiveSheet.Paste
End If
ActiveWorkbook.Save
ActiveSheet.ShowAllData
Application.EnableEvents = True
End Sub

помогите пожалуйста!!!! Заранее спасибо!!!
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444144
AlexXMan,

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
'Для пометок я написал следующий код:
'CODE 1 Ставим флажок если был одиночный щелчок по ячейке
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count >  1  Then Exit Sub
If Not Intersect(Target, Range("A7:A920")) Is Nothing Then
Target.Font.Name = "Marlett"
If Target = vbNullString Then
Target = "a"
Else
Target = vbNullString
End If
End If

End Sub

'CODE 2 Снимаем флажок если был двойной щелчок по ячейке
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A7:A920")) Is Nothing Then
Cancel = True 'чтобы не уйти в режим редактирования
Target.Font.Name = "Marlett"
If Target = vbNullString Then
Target = "a"
Else
Target = vbNullString
End If
End If
End Sub


'а вот с кодом для кнопки постоянно происходят ошибки. Вот он:
Private Sub CommandButton1_Click()
'
'
Application.EnableEvents = False
Sheets("Лист4").Select ' очищаем диапазон от ранее вставленных
Range("A7:D200").Select
Selection.Delete Shift:=xlUp
Sheets("Лист2").Select ' лист с выделениями
Selection.AutoFilter Field:= 2 , Criteria1:="a"
If ActiveSheet.AutoFilter.Range.Columns( 1 ).SpecialCells(xlVisible).Count >  1  Then
Range("A7:D920").Select
Selection.Copy
Sheets("Лист4").Select
Range("A1").Select
ActiveSheet.Paste
End If
ActiveWorkbook.Save
ActiveSheet.ShowAllData
Application.EnableEvents = True
End Sub
Первое, что бросается в глаза: значение меняете в первом столбце, фильтруете по значениям второго.
Ну, и было бы неплохо, раскрыть тайну, на какой строке "кода для кнопки" "постоянно происходят ошибки".
Да и текст ошибок немаловажен.
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444176
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
при нажатии на кнопку пишет Run-time error '1004';
Метод Select из класса Range завершен неверно

и останавливается на строчке Range("A7:D200").Select
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444184
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
а что не так с Range("A7:A920")):
If Not Intersect(Target, Range("A7:A920")) Is Nothing Then????
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444226
88AlexXMan,
попробуйте отказаться от Selection
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
Private Sub CommandButton1_Click()

	Application.EnableEvents = False

	With ActiveWorkbook
	' очищаем диапазон от ранее вставленных
		.WorkSheets("Лист4").[A7:D200].Delete Shift:=xlUp
		
		With Worksheets("Лист2")
			' фильтрация "сырых" данных
			.AutoFilter Field:= 2 , Criteria1:="a"
			
			' копирование при условии если есть что копировать
			If .AutoFilter.Range.Columns( 1 ).SpecialCells(xlVisible).Count >  1  Then _
				.[A7:D920].Copy .Worksheets("Лист4").[A1]
		
		.Parent.Save
		.ShowAllData
		End With
	End With
	
	Application.EnableEvents = True
End Sub
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444228
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Изменил код вот так:
Private Sub CommandButton1_Click()
'

Application.EnableEvents = False
Sheets("Лист4").Select
Sheets("Лист4").Range("A7:H200").Select
Selection.Delete Shift:=xlUp
Sheets("Лист2").Select '
Sheets("Лист2").Range("A7:H920").Select
Selection.AutoFilter Field:=1, Criteria1:="a"
If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlVisible).Count > 1 Then
Range("A7:H920").Select
Selection.Copy
Sheets("Лист4").Select
Sheets("Лист4").Range("A7").Select
ActiveSheet.Paste
End If
ActiveWorkbook.Save
ActiveSheet.ShowAllData
Application.EnableEvents = True
End Sub

появляется ошибка 'Application-defined or object-defined error' и останавливается на строке
ActiveSheet.ShowAllData

и как при отключать фильтр на "Лист2" и копировать ячейки с "Лист2" на "Лист4" вместе с формулами????
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444232
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
а как тогда сделать, как вы предлагаете.... у меня останавливается на строчке
.AutoFilter Field:=1, Criteria1:="a"

и выдает ошибку:
Named agrument not found
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444238
AlexXMan,
авторпоявляется ошибка 'Application-defined or object-defined error' и останавливается на строке
ActiveSheet.ShowAllDataК моменту выполнения метода у Вас активным является Лист4.
Автофильтра на нём нет, вот Excel и высказывает своё недоумение таким экстраординарным образом.

--
Это всего лишь теория, Пух. Но проверить стоит. (с) Ослик Иа

ЗЫ: 11290633 смотрели ?
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444242
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
извините ошибся этот код:
Изменил код вот так:
Private Sub CommandButton1_Click()
'

Application.EnableEvents = False
Sheets("Лист4").Select
Sheets("Лист4").Range("A7:H200").Select
Selection.Delete Shift:=xlUp
Sheets("Лист2").Select '
Sheets("Лист2").Range("A7:H920").Select
Selection.AutoFilter Field:=1, Criteria1:="a"
If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlVisible).Count > 1 Then
Range("A7:H920").Select
Selection.Copy
Sheets("Лист4").Select
Sheets("Лист4").Range("A7").Select
ActiveSheet.Paste
End If
ActiveWorkbook.Save
ActiveSheet.ShowAllData
Application.EnableEvents = True
End Sub

Выдает следующую ошибку:
"Метод ShowallData из класса Worksheet завершен неверно"
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444245
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Закоментировал строчку

ActiveSheet.ShowAllData

ошибки пропали и работает. Все переносит вместе с формулами.....а каким образом выключить фильтр на "Лист2" и под перенесенным списком вставить строку Итого, чтобы в ней считались значения перенесеных столбцов "Сумма", "Сумма со скидкой 20%" и "Сумма со скидкой 30%"????????
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444252
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
и еще одна проблема....если помечаю подряд строчки с первой, тогда формулы переносит. Если же не помечаю подряд хоть одну строку, формулы не переносит!
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444261
AlexXMan,
насчет причины ошибки 'Метод ShowallData из класса Worksheet завершен неверно', моё предположение здесь 11290668 .

И всё-таки буду настойчиво продолжать предлагать отказаться от Selection, ActiveSheet, etc
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
Private Sub CommandButton1_Click()

	Application.EnableEvents = False

	With ActiveWorkbook
	' очищаем диапазон от ранее вставленных
		.WorkSheets("Лист4").[A7:H200].Delete Shift:=xlUp
		
		With Worksheets("Лист2")
			' фильтрация "сырых" данных
			.[A7:H7].AutoFilter Field:= 2 , Criteria1:="a" ' добавлен дипазон ("заголовков") для автофильтра
			
			' копирование при условии если есть что копировать
			If .AutoFilter.Range.Columns( 1 ).SpecialCells(xlVisible).Count >  1  Then _
				.[A7:H920].Copy .Worksheets("Лист4").[A7]
		
		.Parent.Save
		.ShowAllData
		End With
	End With
	
	Application.EnableEvents = True
End Sub


автора каким образом выключить фильтр на "Лист2"Выполнив метод Лист2.ShowAllData

автортобы в ней считались значения перенесеных столбцов "Сумма", "Сумма со скидкой 20%" и "Сумма со скидкой 30%"????????
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
' rem Ваш файл посмотреть нет возможности.
' rem вместо N и X подставьте свои номер и быукву нужного столбца
with worksheets("Лист4")
  k=.UserdRange.Row+ .UserdRange.Rows.Count
  .Cells(k, 1 ).Value2= "Итого"

  ' предполагаю, что в 7-й строке заголовки столбцов, поэтому суммирование с 8-й строки
  .Cells(k,N).Formula= "=SUM(X8:X"& CStr(k- 1 ) & ")"  
end with
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444275
ЗЗЫ: для отключения автофильтра можно/нужно(?) использовать свойство .AutoFilterMode
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444285
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
а почему используя ваш код для копирования строк ничего не происходит...ниодна строчка не копируется!?????
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444289
AlexXMan,
ошибся потому что.
Указал для фильтра только одну строку, а надо было весь диапазон
Код: plaintext
.[A7:H 920 ].AutoFilter Field:= 2 , Criteria1:="a"
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444293
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
хм....странно но все равно ничего не происходит!(
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444303
AlexXMan,
ещё номер поля (указанное Вами в первом посте значение у меня копипастом перекочёвует из поста в пост).

Код: plaintext
1.
.[A7:H920].AutoFilter Field:= 1 , Criteria1:="a" ' было Field:=2
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444312
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
исправив на один написал ошибку:

"Run-time error '438'
Object doesen't support this property or method"

и остановка на строчке

".[A7:H920].Copy .Worksheets("Лист4").[A7]"
(
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444327
это был бальшой аблом (с)Сетор Газа "Сказка"

AlexXMan,
не будем гадать на кофейной гуще, - сохраните Вашу книгу в формате Excel2003, заархивируйте и выкладывайте на форум.
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444331
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
вот!
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444336
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
вот!
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444343
kuklp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
AlexXMan, потому, что у Вас там объединенные ячейки. Уберите объединение и все заработает.
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444354
AlexXMan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
а что можете сказать насчет итоговой суммы.....потому как я даже не знаю как прописывать переменные в VBA...этот код раскопал в инете....я пишу на Embarcadero RAD Studio 2010, но начальству зачем то понадобился Excel!!!! можете помочь с этим итого и с переносом формул....которые почему то невсегда переносятся, а только если отмечаешь строчки подряд, начиная с A7 или с A8
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444355
kuklp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Для 2003.
...
Рейтинг: 0 / 0
Помогите с кодом в Excel
    #37444356
kuklp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
AlexXMan, Чтоб и формулы и форматы:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Private Sub CommandButton1_Click()
    Application.EnableEvents = False
    Sheets("Лист4").Range("A7:H200").Delete Shift:=xlUp
    Me.Outline.ShowLevels rowLevels:= 4 
    Me.Range("A7:H920").AutoFilter  1 , "a"
    Me.Range("A7:H920").SpecialCells( 12 ).Copy Sheets("Лист4").[A7]
    Me.Range("A7:H920").SpecialCells( 12 ).Copy
    Sheets("Лист4").Range("A7").PasteSpecial  11 
    Sheets("Лист2").AutoFilterMode =  0 
    ActiveWorkbook.Save
    Application.EnableEvents = True
End Sub
...
Рейтинг: 0 / 0
25 сообщений из 34, страница 1 из 2
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите с кодом в Excel
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]