powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Где-то напутала с циклами. ХЭЛП
6 сообщений из 6, страница 1 из 1
Где-то напутала с циклами. ХЭЛП
    #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
Где-то напутала с циклами. ХЭЛП
    #36225152
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
У меня отработало без ошибок, но файлы не менялись, на двух погонял.
Кстати, как там "многократное открытие"? Что-то в Вашем коде нет закрытия перед очередным открытием :)
Мне потестировать этот момент трудоёмко, не стал возиться.
...
Рейтинг: 0 / 0
Где-то напутала с циклами. ХЭЛП
    #36225156
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вот этот момент
Код: plaintext
Set OPS = ThisWorkbook
проверьте, мой тест это не проверял, условия не те :)
...
Рейтинг: 0 / 0
Где-то напутала с циклами. ХЭЛП
    #36225171
Oksana Slonevskaya
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
он открывает файл один раз, если выполняется условие, то есть если год и месяц не меняется, это поборола. но вот с циклами какая-то засада, не копирует половину данных+ошибка выскакивает automation error
...
Рейтинг: 0 / 0
Где-то напутала с циклами. ХЭЛП
    #36225327
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Ну а если условие не выполняется - открывает второй раз. А что с открытыми в начале файлами?
Надо код по F8 прогнать - будет видно, где в ошибку выкидывает. И можно для теста On Error GoTo ErrHandler отключить.
...
Рейтинг: 0 / 0
Где-то напутала с циклами. ХЭЛП
    #36226175
MaximuS_G
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я бы предложил для рационализации вместо кучи elseif использовать Select Case...
...
Рейтинг: 0 / 0
6 сообщений из 6, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Где-то напутала с циклами. ХЭЛП
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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