Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Перезагрузить страницу Добавление (удаление) строк в таблице
Регистрация

Восстановить пароль		 Повторная активизация e-mail
Регистрация Задать
вопрос		 Заплачу
за решение		 Новые
сообщения 		Сообщения
за день 		Расширенный
поиск		 Правила Всё
прочитано

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
Страница 3 из 3 12 3
 
Опции темы Поиск в этой теме
Старый 28.12.2011, 22:07   #21
СтаниславАВ
Форумчанин
 
Регистрация: 10.10.2010
Сообщений: 107
По умолчанию
Цитата:
Сообщение от nilem Посмотреть сообщение
Для примера из предпоследнего вложения попробуйте так ("Таблица2" на активном листе):
Код:
Sub AddRow()
    ListObjects("Таблица2").ListRows.Add
End Sub

Sub DelRow()
    With ListObjects("Таблица2")
        .ListRows(.ListRows.Count).Delete
    End With
End Sub
Не работает. Мне предложили такой вариант:
Sub www()
Dim i&, a As Range: On Error Resume Next
With ActiveSheet.ListObjects("Таблица2")
For i = 1 To 4
.Range.AutoFilter i, "=0", 2, "="
For Each a In .DataBodyRange.SpecialCells(12).Are as
a.EntireRow.Delete
Next
.Range.AutoFilter Field:=i
Next
End With
End Sub

Тоже не работает....
СтаниславАВ вне форума Ответить с цитированием
Старый 28.12.2011, 23:14   #22
nilem
Форумчанин
 
Регистрация: 25.04.2010
Сообщений: 616
По умолчанию
Цитата:
Сообщение от СтаниславАВ Посмотреть сообщение
Не работает...
Ну не может быть, чтоб совсем уж не работало. Посмотрите в файле, Е2007/10. Или нужно что-то другое?
Вложения
Тип файла: zip post_292300.zip (14.1 Кб, 30 просмотров)
Последний раз редактировалось nilem; 28.12.2011 в 23:16.
nilem вне форума Ответить с цитированием
Старый 29.12.2011, 06:54   #23
СтаниславАВ
Форумчанин
 
Регистрация: 10.10.2010
Сообщений: 107
По умолчанию
Цитата:
Сообщение от nilem Посмотреть сообщение
Ну не может быть, чтоб совсем уж не работало. Посмотрите в файле, Е2007/10. Или нужно что-то другое?
Спасибо. Работает. А как удалить все строки сразу?
СтаниславАВ вне форума Ответить с цитированием
Старый 29.12.2011, 07:13   #24
СтаниславАВ
Форумчанин
 
Регистрация: 10.10.2010
Сообщений: 107
По умолчанию
Цитата:
Сообщение от nilem Посмотреть сообщение
Ну не может быть, чтоб совсем уж не работало. Посмотрите в файле, Е2007/10. Или нужно что-то другое?
А этот макрос правильно написан?
Вложения
Тип файла: rar Таблица.rar (43.2 Кб, 14 просмотров)
СтаниславАВ вне форума Ответить с цитированием
Старый 29.12.2011, 07:40   #25
СтаниславАВ
Форумчанин
 
Регистрация: 10.10.2010
Сообщений: 107
По умолчанию
Цитата:
Сообщение от nilem Посмотреть сообщение
Ну не может быть, чтоб совсем уж не работало. Посмотрите в файле, Е2007/10. Или нужно что-то другое?
Представляешь, добавил справа таблицу и макрос перестал работать.
Вложения
Тип файла: rar Таблица.rar (44.2 Кб, 12 просмотров)
СтаниславАВ вне форума Ответить с цитированием
Старый 29.12.2011, 10:49   #26
nilem
Форумчанин
 
Регистрация: 25.04.2010
Сообщений: 616
По умолчанию
... Мда, код некрасивый, конечно (если что - писал не я ), но по-другому что-то не получилось. Удаляем строки, у которых в 3-м столбце нули и в 4-м столбце пусто.
Код:
Sub ert()
Dim i&, a As Range, arrCrit: On Error Resume Next
Application.ScreenUpdating = 0
arrCrit = Array(1, 1, 1, "=0", "=")
With Sheets("Расходы").ListObjects("Расходы_товары")
    For i = 3 To 4
        .Range.AutoFilter i, arrCrit(i)
        .DataBodyRange.SpecialCells(12).Select
        .Range.AutoFilter Field:=i
        Selection.Delete shift:=xlUp
    Next
    .Range.AutoFilter
End With: [a1].Select
Application.ScreenUpdating = -1
End Sub
Вложения
Тип файла: zip Таблица2.zip (23.0 Кб, 19 просмотров)
nilem вне форума Ответить с цитированием
Старый 29.12.2011, 21:36   #27
СтаниславАВ
Форумчанин
 
Регистрация: 10.10.2010
Сообщений: 107
По умолчанию
Цитата:
Сообщение от nilem Посмотреть сообщение
... Мда, код некрасивый, конечно (если что - писал не я ), но по-другому что-то не получилось. Удаляем строки, у которых в 3-м столбце нули и в 4-м столбце пусто.
Код:
Sub ert()
Dim i&, a As Range, arrCrit: On Error Resume Next
Application.ScreenUpdating = 0
arrCrit = Array(1, 1, 1, "=0", "=")
With Sheets("Расходы").ListObjects("Расходы_товары")
    For i = 3 To 4
        .Range.AutoFilter i, arrCrit(i)
        .DataBodyRange.SpecialCells(12).Select
        .Range.AutoFilter Field:=i
        Selection.Delete shift:=xlUp
    Next
    .Range.AutoFilter
End With: [a1].Select
Application.ScreenUpdating = -1
End Sub
Спасибо за помощь. Делаю семейный бюджет. Попробуй. Оцени.
Сначала нажми зелёную кнопку "Удаление данных" (Макрос удалит все старые данные предыдущего года)
А затем "Добавить" (Макрос вставит несколько первых расходов текущего года)
Вложения
Тип файла: rar Семейный.rar (675.9 Кб, 30 просмотров)
СтаниславАВ вне форума Ответить с цитированием
Старый 29.12.2011, 21:40   #28
СтаниславАВ
Форумчанин
 
Регистрация: 10.10.2010
Сообщений: 107
По умолчанию
Цитата:
Сообщение от СтаниславАВ Посмотреть сообщение
Спасибо за помощь. Делаю семейный бюджет. Попробуй. Оцени.
Сначала нажми зелёную кнопку "Удаление данных" (Макрос удалит все старые данные предыдущего года)
А затем "Добавить" (Макрос вставит несколько первых расходов текущего года)
И вроде в тему. Добавление (удаление) строк в таблице. Есть и удаление строк и добавление. Жду замечаний и рекомендаций. )))
СтаниславАВ вне форума Ответить с цитированием
Старый 31.12.2011, 13:03   #29
СтаниславАВ
Форумчанин
 
Регистрация: 10.10.2010
Сообщений: 107
По умолчанию
Sub Удаление_данных() ' Удаление прошлогодних данных
Application.ScreenUpdating = False
Sheets("дек").Select
Range("I10").Select
Selection.ClearContents
Range("I11").Select
Selection.ClearContents

Sheets("ноя").Select
Range("I10").Select
Selection.ClearContents
Range("I11").Select
Selection.ClearContents

Sheets("окт").Select
Range("I10").Select
Selection.ClearContents
Range("I11").Select
Selection.ClearContents

Sheets("сен").Select
Range("I10").Select
Selection.ClearContents
Range("I11").Select
Selection.ClearContents

Sheets("авг").Select
Range("I10").Select
Selection.ClearContents
Range("I11").Select
Selection.ClearContents

Sheets("июл").Select
Range("I10").Select
Selection.ClearContents
Range("I11").Select
Selection.ClearContents

Sheets("июн").Select
Range("I10").Select
Selection.ClearContents
Range("I11").Select
Selection.ClearContents

Sheets("май").Select
Range("I10").Select
Selection.ClearContents
Range("I11").Select
Selection.ClearContents

Sheets("апр").Select
Range("I10").Select
Selection.ClearContents
Range("I11").Select
Selection.ClearContents

Sheets("мар").Select
Range("I10").Select
Selection.ClearContents
Range("I11").Select
Selection.ClearContents

Sheets("фев").Select
Range("I10").Select
Selection.ClearContents
Range("I11").Select
Selection.ClearContents

Sheets("янв").Select
Range("I10").Select
Selection.ClearContents
Range("I11").Select
Selection.ClearContents

Sheets("Расходы").Select
Call Ydalerie
Call Zapolnenie
Application.ScreenUpdating = True
End Sub

Sub Ydalerie() 'Удаление всех расходов
Dim i&, a As Range, arrCrit: On Error Resume Next
Application.ScreenUpdating = 0
arrCrit = Array(1, 1, 1, "=", "=")
With Sheets("Расходы").ListObjects("Расх оды_товары")
For i = 3 To 4
.Range.AutoFilter i, arrCrit(i)
.DataBodyRange.SpecialCells(12).Sel ect
.Range.AutoFilter Field:=i
Selection.Delete shift:=xlUp
Next
.Range.AutoFilter
End With: [a1].Select
Application.ScreenUpdating = -1
End Sub
Sub Zapolnenie() ' Заполнение первой строки

Range("A2").Select
ActiveCell.FormulaR1C1 = "1"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=янв!R[1]C[4]"
Range("E2").Select
ActiveCell.FormulaR1C1 = "1"
Range("F2").Select
ActiveCell.FormulaR1C1 = "1"
Range("G2").Select
ActiveCell.FormulaR1C1 = "Продукты"
With ActiveCell.Characters(Start:=1, Length:=8).Font
.Name = "Comic Sans MS"
.FontStyle = "обычный"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("H2").Select
ActiveCell.FormulaR1C1 = "0"
Range("I2").Select
ActiveCell.FormulaR1C1 = "1"
Range("J2").Select
ActiveCell.FormulaR1C1 = "Папа"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Comic Sans MS"
.FontStyle = "обычный"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("K2").Select
ActiveCell.FormulaR1C1 = "=MONTH(Расходы_товары[[#This Row],[Дата]])"
Range("L2").Select
ActiveCell.FormulaR1C1 = "=YEAR(Расходы_товары[[#This Row],[Дата]])"
Range("A2:L2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("P4").Select
End Sub
СтаниславАВ вне форума Ответить с цитированием
Старый 01.01.2012, 22:31   #30
VictorM
Старожил
 
Аватар для VictorM
 
Регистрация: 15.05.2008
Сообщений: 2,058
По умолчанию
Цитата:
Жду замечаний и рекомендаций. )))
По первой процедуре, попробуйте так:
(не проверял, лень делать книгу с 12 листами )
Код:
Sub Удаление_данных()    ' Удаление прошлогодних данных
    Application.ScreenUpdating = False
    imes = Array("янв", "фев", "мар", "апр", "май", "июн", "июл", "авг", "сен", "окт", "ноя", "дек")
    For i = 0 To 11
        Sheets(imes(i)).Range("I10:I11").ClearContents
    Next i
    Application.Goto Reference:=Worksheets("Расходы").[a1]    ' указать нужную ячейку
    Call Ydalerie
    Call Zapolnenie
    Application.ScreenUpdating = True
End Sub
"Дайте людям рыбы, и вы накормите их на весь день; научите их ловить рыбу - и вы накормите их на всю жизнь"
"Большое спасибо" - Z261597841314, R208907249777, U447361470499
Последний раз редактировалось VictorM; 01.01.2012 в 22:35.
VictorM вне форума Ответить с цитированием
Ответ
Страница 3 из 3 12 3


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Добавление данных из Delphi в таблице Excel Neket21 БД в Delphi 1 23.07.2009 08:06
добавление в таблице CJartem Помощь студентам 0 25.04.2009 12:20
добавление строки в таблице nikleb JavaScript, Ajax 14 09.03.2009 13:27
Удаление/добавление полей runtime /Denis/ БД в Delphi 1 06.08.2008 22:35
Добавление и удаление записей в Listview Scorpeon Компоненты Delphi 0 08.06.2007 23:09

Реклама на форуме - Обратная связь - Правила - Исходники Delphi - Справочник Delphi - Архив - Вверх