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

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

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

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

Ответ
 
Опции темы Поиск в этой теме
Старый 18.11.2010, 11:57   #11
staniiislav
Форумчанин
 
Аватар для staniiislav
 
Регистрация: 16.04.2010
Сообщений: 695
По умолчанию

Цитата:
Сообщение от EugeneS Посмотреть сообщение
попробуйте вот так:

Код:
Sub month1()
Dim wsh As Worksheet, wb As Workbook, x, i As Long, k As Long, imonth As String, shname As String, ipar As String
Application.ScreenUpdating = False
imonth = Month([a1]): shname = Year([a1]): ipar = [b1]
Set wb = GetObject(ThisWorkbook.Path & "\БД.xls")
On Error GoTo Handler: With wb.Sheets(shname):
    x = .Range("A1:E" & .Cells(Rows.Count, 3).End(xlUp).Row).Value
    For i = 1 To UBound(x, 1) Step 16
        If Month(x(i, 1)) = (imonth) And x(i, 2) = ipar Then
            .Range("A1:E16").Offset(i - 1).Copy Range("A2").Offset(16 * k)
            k = k + 1
        End If
    Next i
wb.Close (False): End With: On Error GoTo 0: Application.ScreenUpdating = True: Exit Sub
Handler:
MsgBox "Лист с именем " & shname & " отсутствует в книге БД.xls", vbInformation: Exit Sub
End Sub

Оооо вроде все работает! Спасибочки. А в чем была проблема?
Я убрал проверку по столбцу В, в данном случаи она не нужна. Надеюсь правильно работать будет и без проблемм))))

Sub month1()
Dim wsh As Worksheet, wb As Workbook, x, i As Long, k As Long, imonth As String, shname As String, ipar As String
Application.ScreenUpdating = False
imonth = month([a1]): shname = Year([a1])
Set wb = GetObject(ThisWorkbook.Path & "\БД.xls")
With wb.Sheets(shname)
x = .Range("A1:E" & .Cells(Rows.Count, 3).End(xlUp).Row).Value
For i = 1 To UBound(x, 1) Step 16 'например, наши ПТ1 находятся во 2-й строке
If month(x(i, 1)) = (imonth) Then
.Range("A1:E16").Offset(i - 1).Copy Range("A2").Offset(16 * k)
k = k + 1
End If
Next i
wb.Close (False)
End With
Application.ScreenUpdating = True
End Sub
Единственный способ стать умнее, играть с более умным противником...

Последний раз редактировалось staniiislav; 18.11.2010 в 12:00.
staniiislav вне форума Ответить с цитированием
Старый 18.11.2010, 16:51   #12
staniiislav
Форумчанин
 
Аватар для staniiislav
 
Регистрация: 16.04.2010
Сообщений: 695
Радость

Можно еще вопросик. Куда правильно будет вставить MsgBox, чтобы выводили сообщение "такого месяца еще нет", если счетчик не нашел данный месяц

Sub month1()
Dim wsh As Worksheet, wb As Workbook, x, i As Long, k As Long, imonth As String, shname As String
Application.ScreenUpdating = False
imonth = month([a1]): shname = Year([a1])
Set wb = GetObject(ThisWorkbook.Path & "\БД.xls")
On Error GoTo Handler: With wb.Sheets(shname):
x = .Range("A1:E" & .Cells(Rows.Count, 3).End(xlUp).Row).Value
For i = 1 To UBound(x, 1) Step 16
If month(x(i, 1)) = (imonth) Then
.Range("A1:E16").Offset(i - 1).Copy Range("A2").Offset(16 * k)
k = k + 1
End If
Next i
wb.Close (False): End With: On Error GoTo 0: Application.ScreenUpdating = True: Exit Sub
Handler:
MsgBox "Лист с именем " & shname & " отсутствует в книге БД.xls", vbInformation: wb.Close (False): Exit Sub
End Sub
Единственный способ стать умнее, играть с более умным противником...
staniiislav вне форума Ответить с цитированием
Старый 18.11.2010, 21:40   #13
EugeneS
Форумчанин
 
Регистрация: 06.08.2009
Сообщений: 472
По умолчанию

Цитата:
Сообщение от staniiislav Посмотреть сообщение
Можно еще вопросик. Куда правильно будет вставить MsgBox, чтобы выводили сообщение "такого месяца еще нет", если счетчик не нашел данный месяц
Проблемы не было, просто Вам написали макрос для поиска по всем листам независимо от имени листа.

Можно сделать так:

Код:
...
Next i
If k = 0 Then MsgBox "Указанный месяц отсутствует на листе " & shname, vbinformation
...
EugeneS вне форума Ответить с цитированием
Старый 23.11.2010, 17:56   #14
staniiislav
Форумчанин
 
Аватар для staniiislav
 
Регистрация: 16.04.2010
Сообщений: 695
По умолчанию

Всем огромное спасибо!!! Вроде все работает ))) надеюсь проблем не будет!!!
Единственный способ стать умнее, играть с более умным противником...
staniiislav вне форума Ответить с цитированием
Старый 24.11.2010, 14:14   #15
staniiislav
Форумчанин
 
Аватар для staniiislav
 
Регистрация: 16.04.2010
Сообщений: 695
По умолчанию

Можно еще один вопрос, если я размещаю данные файле в сетевой папке на сервере, у меня тает ошибка Run-time error "432"
Я так понимаю это связано с GetObject, как правильно путь указать, если сам путь начинается с \\00dc\111\БД.xls? подскажите пожалуйста!
Единственный способ стать умнее, играть с более умным противником...
staniiislav вне форума Ответить с цитированием
Старый 24.11.2010, 14:46   #16
staniiislav
Форумчанин
 
Аватар для staniiislav
 
Регистрация: 16.04.2010
Сообщений: 695
По умолчанию

Цитата:
Сообщение от staniiislav Посмотреть сообщение
Можно еще один вопрос, если я размещаю данные файле в сетевой папке на сервере, у меня тает ошибка Run-time error "432"
Я так понимаю это связано с GetObject, как правильно путь указать, если сам путь начинается с \\00dc\111\БД.xls? подскажите пожалуйста!
Уже нашел решение проблемы. Не правильно была указана конечная папка.
Единственный способ стать умнее, играть с более умным противником...
staniiislav вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
По диапазону с датами построить график по месяцам, как? O_H Microsoft Office Excel 15 14.03.2014 15:04
Формула суммирования по месяцам parsn Microsoft Office Excel 10 26.02.2010 15:01
Форма для заполнения данных по зарплате сотрудников по месяцам touchka Microsoft Office Access 1 04.02.2010 22:46
нужно вывести кол-во покупаемых товаров по месяцам(т.е сколько было куплено в том или ином месяце) apelset Microsoft Office Excel 5 20.05.2009 19:09
поиск Lonix Общие вопросы Delphi 2 04.04.2007 01:59