Добавление строк в Excel по условию / HTML, JavaScript, VBScript, CSS

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / HTML, JavaScript, VBScript, CSS [игнор отключен] [закрыт для гостей] / Добавление строк в Excel по условию

9 сообщений из 9, страница 1 из 1

Добавление строк в Excel по условию

#38114285

Кошелев Дмитрий

Гость

Добрый день!

Подскажите пожалуйста, можно ли реализовать такую задачку с помощью макроса в Excel?

Необходимо перебрать даты, чтобы получилось как в примере во вложении.

Суть задачи:
Есть клиенты с датой подключения к услуге и датой отключения от услуги. Необходимо сравнивая эти даты копировать строки ниже просматриваемой строки, либо переходить к следующей.

Возьмем 2 даты:
01.01.2012 - 25.04.2012

Необходимо получить:

01.01.2012 - "-"
01.02.2012 - "-"
01.03.2012 - "-"
01.04.2012 - 25.04.2012

Условие для перехода:

Если ДатаКонец="-", тогда ДатаРезультат = "-" и переход к след. строчке. Иначе выполняем условие:

ДатаРезультат = "-" и

Если ДатаНачала<ДатаКонец, тогда необходимо добавить строку ниже и скопировать все содержимое строки изменив в ДатаНачало = Добавить 1 месяц к ДатеНачало.

Как только дата ДатаНачало>ДатыКонец, переход к след строке и все по новой.

Очень надеюсь на вашу помощь!!! Мозг закипает уже, т.к. недавно занимаюсь программированием.

...

Рейтинг:

0 / 0

17.01.2013, 16:56

| Ответить | Цитировать | Написать

Добавление строк в Excel по условию

#38114701

Кошелев Дмитрий

Гость

Что-то получилось, но выполняется не совсем правильно. Цикл бегать не хочет(((

P.s.: Как я уже говорил, я нуб...поэтому не судите строго)))

Код: vbnet

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.

'********** Создаем объект Excel ****************************************************
  		Set xlApp = CreateObject("Excel.Application")
		
		'********** Устанавливаем видимость объекта *****************************************
		xlApp.Visible = true
		
		'*********** Назначаем переменные для открытия книги, листа, объекта ****************
		Set xlWB = xlApp.Workbooks.Open(FileName)
		Set xlSheet1 = xlWB.Worksheets(1)
		Set xlSheet2 = xlWB.Worksheets(2)
		Set obj = ActiveDocument.GetSheetObject(ChartName) 
		
		'*********** Активируем лист ********************************************************
		
		iRow1=2
		iRow2=2
			
		For iRow1=2 to iRow1+1
			xlSheet1.Activate
			if(xlSheet1.Cells(iRow1,6).Value = "-") THEN 
				xlSheet1.Range(xlSheet1.Cells(iRow1,1),xlSheet1.Cells(iRow1,15)).Copy
				iRow1=iRow1+1
			else 
				if(xlSheet1.Cells(iRow1,5).value<xlSheet1.Cells(iRow1,6).value) THEN
					xlSheet1.cells(iRow1,6).value = "-"
					xlSheet1.Range(xlSheet1.Cells(iRow1,1),xlSheet1.Cells(iRow1,15)).Copy
				Else
				        xlSheet1.Range(xlSheet1.Cells(iRow1,1),xlSheet1.Cells(iRow1,15)).Copy
				end if
			end if
				
				xlSheet2.Activate
				
				While Not(Isempty(xlSheet2.Cells(iRow2,1)))
					iRow2=iRow2+1
				Wend
				
				xlSheet2.Cells(iRow2,1).Select
				xlSheet2.Paste
		Next

...

Рейтинг:

0 / 0

18.01.2013, 00:59

| Ответить | Цитировать | Написать

Добавление строк в Excel по условию

#38114835

не силен в Excel

Гость

Кошелев Дмитрий,

а точно нужно макросом в Excel?
Просто это задача решатся легко на T-SQL. Там есть способы работать напрямую с Excel. Можно поставить себе бесплатный SQL Express, я бы написал решение.

...

Рейтинг:

0 / 0

18.01.2013, 09:04

| Ответить | Цитировать | Написать

Добавление строк в Excel по условию

#38114952

не силен в Excel

Гость

Кошелев Дмитрий,

тут набросал говнокодец, архив прилагаю. После распаковки запустите файл script.vbs

...

Рейтинг:

0 / 0

18.01.2013, 10:52

| Ответить | Цитировать | Написать

Добавление строк в Excel по условию

#38114956

не силен в Excel

Гость

Кошелев Дмитрий,

странно, файл не приложился... Попытка №2

Содержимое script.vbs

Код: vbnet

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.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.

Option Explicit

dim xlApp, xlSheet1, i, RowCnt, d1, d2, k

'********** Создаем объект Excel ****************************************************
Set xlApp = CreateObject("Excel.Application")

'Отключаем реакцию Excel на события, чтобы ускорить вывод информации
xlApp.Application.EnableEvents = false
		
xlApp.Visible = true
xlApp.Workbooks.Open("f.xls")
Set xlSheet1 = xlApp.Worksheets(1)
xlSheet1.Activate


xlSheet1.Range(xlSheet1.Cells(1,1),xlSheet1.Cells(1,6)).Copy
xlSheet1.Cells(1,9).Select
xlSheet1.Paste
xlSheet1.Cells(1,15) = "ДатаРезультата"

'Чтобы узнать количество строк и столбцов, мы активируем последнюю непустую ячейку (нажали Ctrl+End)
xlSheet1.Cells.SpecialCells(11).Select
'Получаем значение последней строки
RowCnt = (xlApp.ActiveCell.Row)

k = 2

For i = 2 to RowCnt
  if k < 3 then k = i

  d1 = xlSheet1.Cells(i,5)
  d2 = xlSheet1.Cells(i,6)
  
  if d2 = "-" then 
    xlSheet1.Range(xlSheet1.Cells(i,1),xlSheet1.Cells(i,6)).Copy
	xlSheet1.Cells(i,9).Select
	xlSheet1.Paste
	xlSheet1.Cells(i,15) = "-"
  else
    while d1 < d2
	  xlSheet1.Cells(k,9) = k-1
      xlSheet1.Cells(k,10) = xlSheet1.Cells(i,2)
	  xlSheet1.Cells(k,11) = xlSheet1.Cells(i,3)
	  xlSheet1.Cells(k,12) = xlSheet1.Cells(i,4)
      xlSheet1.Cells(k,13) = d1
      xlSheet1.Cells(k,14) = d2
	  xlSheet1.Cells(k,15) = "-"
	  d1 = DateAdd("m",1,d1)
	  k = k + 1
	wend
	if d1 > d2 then	xlSheet1.Cells(k-1,15) = d2

  end if
Next

'Автоподбор ширины у всего листа
xlSheet1.Columns.AutoFit

'Снять режим CopyPaste
xlApp.Application.CutCopyMode = False

'Линии для красоты
xlSheet1.Range(xlSheet1.Cells(1,9),xlSheet1.Cells(k-1,15)).Select
xlApp.Selection.Borders(7).LineStyle = 1
xlApp.Selection.Borders(8).LineStyle = 1
xlApp.Selection.Borders(9).LineStyle = 1
xlApp.Selection.Borders(10).LineStyle = 1
xlApp.Selection.Borders(11).LineStyle = 1
xlApp.Selection.Borders(12).LineStyle = 1

xlSheet1.Cells(1,1).Select

...

Рейтинг:

0 / 0

18.01.2013, 10:57

| Ответить | Цитировать | Написать

Добавление строк в Excel по условию

#38115551

Кошелев Дмитрий

Гость

Спасибо большое за помощь!!! Все работает. Сейчас прогоняется.

Правда я сам сделал нечто похожее, правда чуть по другому...позже кину на ознакомление.

У меня все копируется не рядом, а на другой лист...

...

Рейтинг:

0 / 0

18.01.2013, 15:19

| Ответить | Цитировать | Написать

Добавление строк в Excel по условию

#38115561

Кошелев Дмитрий

Гость

Код: vbnet

Set xlApp = CreateObject("Excel.Application")
		
		'********** Устанавливаем видимость объекта *****************************************
		xlApp.Visible = true
		
		'*********** Назначаем переменные для открытия книги, листа, объекта ****************
		Set xlWB = xlApp.Workbooks.Open(FileName)
		Set xlSheet1 = xlWB.Worksheets(1)
		Set xlSheet2 = xlWB.Worksheets(2)
		Set obj = ActiveDocument.GetSheetObject(ChartName) 
		
		'*********** Активируем лист ********************************************************
		
		iRow1=2
		iRow2=2
		While Not(Isempty(xlSheet1.Cells(iRow1,1)))


			for each Range in xlSheet1.Range(xlSheet1.Cells(iRow1,1),xlSheet1.Cells(iRow1,15))
			
			xlSheet1.Activate
			
			if(xlSheet1.Cells(iRow1,6).Value = "-") THEN 
				xlSheet1.Cells(iRow1,11).value = "-"
				xlSheet1.Range(xlSheet1.Cells(iRow1,1),xlSheet1.Cells(iRow1,15)).Copy
				iRow1=iRow1+1
			else 
				
				if(xlSheet1.Cells(iRow1,5).value<xlSheet1.Cells(iRow1,6).value) THEN

					xlSheet1.cells(iRow1,11).value = "-"
					xlSheet1.Range(xlSheet1.Cells(iRow1,1),xlSheet1.Cells(iRow1,15)).Copy
					xlSheet1.cells(iRow1,5).value = dateadd("m",1,xlSheet1.cells(iRow1,5).value)
				Else
					xlSheet1.cells(iRow1,11).value = xlSheet1.cells(iRow1,6).value
					xlSheet1.Range(xlSheet1.Cells(iRow1,1),xlSheet1.Cells(iRow1,15)).Copy
					iRow1=iRow1+1
				end if
				
				
				
			end if
				
				
				
				xlSheet2.Activate
				
				xlSheet2.Cells(iRow2,1).Select
				xlSheet2.Paste
				iRow2=iRow2+1
			next	
		
		Wend

...

Рейтинг:

0 / 0

18.01.2013, 15:22

| Ответить | Цитировать | Написать

Добавление строк в Excel по условию

#38115610

не силен в Excel

Гость

Кошелев ДмитрийУ меня все копируется не рядом, а на другой лист...
Option Explicit надо обязательно использовать

Удалите вообще все упоминания про xlSheet2 из скрипта.
Вот это

Код: vbnet

1.
2.
3.

xlSheet2.Activate
xlSheet2.Cells(iRow2,1).Select
xlSheet2.Paste

Попробуйте заменить на

Код: vbnet

1.
2.

xlSheet1.Cells(iRow2,1).Select
xlSheet1.Paste

...

Рейтинг:

0 / 0

18.01.2013, 15:52

| Ответить | Цитировать | Написать

Добавление строк в Excel по условию

#38115977

Кошелев Дмитрий

Гость

Уже понял свою ошибку) Переделал) Все работает отлично) Вместо 5 часов, загружает все за два)

...

Рейтинг:

0 / 0

18.01.2013, 20:20

| Ответить | Цитировать | Написать

9 сообщений из 9, страница 1 из 1

Форумы / HTML, JavaScript, VBScript, CSS [игнор отключен] [закрыт для гостей] / Добавление строк в Excel по условию

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=22&msg=38115977&tid=1448833]:	0ms
get settings:	10ms
get forum list:	16ms
check forum access:	3ms
check topic access:	3ms
track hit:	29ms
get topic data:	10ms
get forum data:	7ms
get page messages:	33ms
get tp. blocked users:	1ms
others:	257ms

total:	369ms

	Необходимые cookie
	Cookie для сбора статистики
	Cookie для маркетинга и рекламы