Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Где-то напутала с циклами. ХЭЛП / 6 сообщений из 6, страница 1 из 1
30.09.2009, 12:58:49
    #36224830
Oksana Slonevskaya
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Где-то напутала с циклами. ХЭЛП
Код: 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.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
Private Sub CommandButton1_Click()
    Dim dFirstDate As Date         'объявление переменных
    Dim dLastDate As Date
    Dim dDate As Date
    Dim iDay As Integer
    Dim sMonthname As String
    Dim iMonthNum As Integer
    Dim iYear As Integer
    Dim i As Integer
    Dim wb As Workbook
    Dim OPS As Workbook
    Dim iTempY As Integer
    Dim iTempM As Integer
    Dim Ref As Workbook
    Dim j As Integer
    
    
dFirstDate = ActiveWorkbook.Worksheets("Week Summary").Range("C7").Value 'определяем дату начала недели
dLastDate = ActiveWorkbook.Worksheets("Week Summary").Range("W7").Value  'определяем дату конца недели
 
 'определяем, введена ли начальная и конечная даты недели
 
 If IsEmpty(ActiveWorkbook.Worksheets("Week Summary").Range("C7")) Then
    MsgBox ("Введите дату начала недели в листе Week Summary")
 ElseIf IsEmpty(ActiveWorkbook.Worksheets("Week Summary").Range("W7")) Then
    MsgBox ("Введите дату конца недели в листе Week Summary")
  Else
     iTempY =  0  'временная переменная для определения года
     iTempM =  0  'временная переменная для определения месяца
    For dDate = dFirstDate To dLastDate
      iMonthNum = DatePart("m", dDate)       'определение номера месяца
      iDay = DatePart("d", dDate)            'определение номера дня
      iYear = DatePart("yyyy", dDate)        'определение номера года
      sMonthname = fGetMonthName(iMonthNum)  'вызов функции, которая возвращает название месяца по его номеру
      Application.ScreenUpdating = False     'запрет обновления экрана
        'проверка, соответствует ли начальный год и месяц текущему
         If (iTempY <> iYear) Or (iTempM <> iMonthNum) Then
           Set wb = Workbooks.Open("\\eu.dir.bunge.com\KEP\Shared Projects\Operations Reports\QC Reports - Crush & Seeds\" & iYear & "\QC Crush " & sMonthname & ".xls", False)
           Set Ref = Workbooks.Open("\\eu.dir.bunge.com\KEP\Shared Projects\Operations Reports\QC Reports - Refinery & Bottling\" & iYear & "\QC Report Refinery " & sMonthname & ".xls", False)
           
           On Error GoTo ErrHandler
           iTempY = iYear      'присваиваем временную переменную текущему значению года
           iTempM = iMonthNum  ''присваиваем временную переменную текущему значению месяца
         End If
         'копирование нужных значений ячеек из файла QC Crush
       For i =  1  To wb.Worksheets("Crush").UsedRange.Rows.Count
         For j =  1  To Ref.Worksheets("Flows in Process").UsedRange.Rows.Count
        If wb.Worksheets.Item("Crush").Cells(i,  4 ).Value = iDay Then
          If wb.Worksheets.Item("Crush").Cells(i,  5 ).Value = ("Д1 Массовая доля сора,%") Then
             Set OPS = ThisWorkbook
             OPS.Worksheets.Item("Data input Volumes & Quality").Cells( 30 ,  20  + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i,  32 ).Value
             ElseIf wb.Worksheets.Item("Crush").Cells(i,  5 ).Value = ("Д1 Массовая доля влаги,%") Then
             Set OPS = ThisWorkbook
             OPS.Worksheets.Item("Data input Volumes & Quality").Cells( 31 ,  20  + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i,  32 ).Value
             ElseIf wb.Worksheets.Item("Crush").Cells(i,  5 ).Value = ("Д1 Массовая доля масла M0, %") Then
             Set OPS = ThisWorkbook
             OPS.Worksheets.Item("Data input Volumes & Quality").Cells( 32 ,  20  + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i,  32 ).Value
             ElseIf wb.Worksheets.Item("Crush").Cells(i,  5 ).Value = ("Д1 Лузжистость при факт.влажности и сорности Л0,%") Then
             Set OPS = ThisWorkbook
             OPS.Worksheets.Item("Data input Volumes & Quality").Cells( 35 ,  20  + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i,  32 ).Value
             ElseIf wb.Worksheets.Item("Crush").Cells(i,  5 ).Value = ("Д3Л Вынос ядра,%") Then
             Set OPS = ThisWorkbook
             OPS.Worksheets.Item("Data input Volumes & Quality").Cells( 37 ,  20  + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i,  32 ).Value
             ElseIf wb.Worksheets.Item("Crush").Cells(i,  5 ).Value = ("Д7 Протеин, %") Then
             Set OPS = ThisWorkbook
             OPS.Worksheets.Item("Data input Volumes & Quality").Cells( 38 ,  20  + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i,  32 ).Value
             ElseIf wb.Worksheets.Item("Crush").Cells(i,  5 ).Value = ("Д7 Массовая доля влаги, %") Then
             Set OPS = ThisWorkbook
             OPS.Worksheets.Item("Data input Volumes & Quality").Cells( 39 ,  20  + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i,  32 ).Value
             ElseIf wb.Worksheets.Item("Crush").Cells(i,  5 ).Value = ("Д7  Массовая доля масла,%") Then
             Set OPS = ThisWorkbook
             OPS.Worksheets.Item("Data input Volumes & Quality").Cells( 40 ,  20  + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i,  32 ).Value
             ElseIf wb.Worksheets.Item("Crush").Cells(i,  5 ).Value = ("Д3Л Массовая доля масла,%") Then
             Set OPS = ThisWorkbook
             OPS.Worksheets.Item("Data input Volumes & Quality").Cells( 41 ,  20  + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i,  32 ).Value
          End If
         End If
          Next j
        Next i
          
  'копирование нужных значений ячеек из файла QC Refinery
  
   If Ref.Worksheets.Item("Flows in Process").Cells(i,  4 ).Value = iDay Then
     If Ref.Worksheets.Item("Flows in Process").Cells(i,  6 ).Value = ("P10 Deodorised Oil Cold Test 1hr") Then
     Set OPS = ThisWorkbook
     OPS.Worksheets.Item("Data input Volumes & Quality").Cells( 44 ,  20  + (dDate - dFirstDate)).Value = Ref.Worksheets.Item("Crush").Cells(i,  34 ).Value
  
  
   End If
     End If
  
   Next dDate
  End If
   wb.Close
   Ref.Close
   

   
ExitHandler:
    Application.ScreenUpdating = True 'разрешение обновления экрана (чтобы видеть внесенные изменения)
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler


 
  
End Sub
...
Рейтинг: 0 / 0
30.09.2009, 14:19:46
    #36225152
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Где-то напутала с циклами. ХЭЛП
У меня отработало без ошибок, но файлы не менялись, на двух погонял.
Кстати, как там "многократное открытие"? Что-то в Вашем коде нет закрытия перед очередным открытием :)
Мне потестировать этот момент трудоёмко, не стал возиться.
...
Рейтинг: 0 / 0
30.09.2009, 14:21:50
    #36225156
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Где-то напутала с циклами. ХЭЛП
Вот этот момент
Код: plaintext
Set OPS = ThisWorkbook
проверьте, мой тест это не проверял, условия не те :)
...
Рейтинг: 0 / 0
30.09.2009, 14:25:45
    #36225171
Oksana Slonevskaya
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Где-то напутала с циклами. ХЭЛП
он открывает файл один раз, если выполняется условие, то есть если год и месяц не меняется, это поборола. но вот с циклами какая-то засада, не копирует половину данных+ошибка выскакивает automation error
...
Рейтинг: 0 / 0
30.09.2009, 15:07:28
    #36225327
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Где-то напутала с циклами. ХЭЛП
Ну а если условие не выполняется - открывает второй раз. А что с открытыми в начале файлами?
Надо код по F8 прогнать - будет видно, где в ошибку выкидывает. И можно для теста On Error GoTo ErrHandler отключить.
...
Рейтинг: 0 / 0
30.09.2009, 19:51:45
    #36226175
MaximuS_G
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Где-то напутала с циклами. ХЭЛП
Я бы предложил для рационализации вместо кучи elseif использовать Select Case...
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Где-то напутала с циклами. ХЭЛП / 6 сообщений из 6, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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