Написать макрос для рассчета доли

@caustic · Регистрация: 30.09.2011

Студворк — интернет-сервис помощи студентам

добрый день!

первый раз пишу в этом разделе форума, поэтому если мой запрос невыполним, заранее извиняюсь )

Суть вопроса такова, Необходимо в колонке H, по средствам макроса, выполнить расчет так, чтоб для желтых строчек доля высчитывалась только от значения первой желтой ячейки "Total_sum", а для серых - доля высчитывалась от первой верхней желтой ячейки (см приложение, там формулы покажут как необходимо производить расчет)

надеюсь объяснил понятно

реально ли это сделать и если да, то как

спасибо!

@Alex77755 · 01.11.2012, 02:03

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub QWERT()
lr = Cells(Rows.Count, 1).End(xlUp).Row + 1
SM = Cells(3, 2)
St = Cells(r, 2)
For r = 4 To lr
    If Cells(r, 1).Interior.ColorIndex = 6 Then
       Cells(r, 8) = Cells(r, 2) / SM
       St = Cells(r, 2)
    Else
       Cells(r, 8) = Cells(r, 2) / St
    End If
Next r
End Sub

@caustic · 01.11.2012, 07:06 **[ТС]**

Сообщение от Alex77755

Код Visual Basic

спасибо,
но при выполнении макроса в приложенном мной файле, выскакивает ошибка

Code
1
2
Run-time error '1004': 
Application-defined or object-defined error

debug подсвечивает эту строчку:

Code
1
St = Cells(r, 2)

в чем может быть проблема? судя по описанию на сайте майкрософт это происходит при копировании листа или присвоении ему имени без предв. сохранения..

ОС: Vista/7 Office: 2007/10

@Апострофф · 01.11.2012, 08:04

caustic, ошибка происходит из-за незаданного r (=0?).
Это одно из следствий игнорирования Option Ecplicit

@caustic · 01.11.2012, 09:30 **[ТС]**

Сообщение от Апострофф

Это одно из следствий игнорирования Option Ecplicit

а я сам как нить могу это исправить?

Добавлено через 1 час 22 минуты
спасибо, макрос подкорректировали. теперь работает:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub QWERT()
 
Dim r As Integer
 
r = 0
 
lr = Cells(Rows.Count, 1).End(xlUp).Row + 1
SM = Cells(3, 2)
St = Cells(lr, 2)
For r = 4 To lr
    If Cells(r, 1).Interior.ColorIndex = 6 Then
       Cells(r, 8) = Cells(r, 2) / SM
       St = Cells(r, 2)
    Else
       Cells(r, 8) = Cells(r, 2) / St
    End If
Next r
End Sub

@Alex77755 · 01.11.2012, 10:03

Должно быть так:

Visual Basic
1
2
SM = Cells(3, 2)
St = Cells(3, 2)

Добавлено через 3 минуты
ошибка из-за этого: r = 0 - нет нулевой строки.
Можно было r = 3.
Сорри. перекопировал строку из цикла и не исправил

@caustic · 01.11.2012, 15:54 **[ТС]**

ребят, а как подкорректировать код так, чтобы

при пустом значении ячейке в колонке B (не желтой ячейки), макрос не останавливался, а просто пропускал строчку, оставляя ее пустой и продолжал расчет.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
     Dim i, j As Integer
iArray = Array("ваываыва", "вавыаываыва", "fgdfgdfg")
 
For j = 0 To 2
    For i = 1 To 1000
     If Cells(i, 1).Value = iArray(j) Then
      Rows(i).Select
        With Selection.Interior
            .PatternColorIndex = xlAutomatic
            .Color = vbYellow
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Selection.FormatConditions.Delete
     End If
    Next i
Next j

@Alex77755 · 01.11.2012, 16:07

caustic, Без файла трудно понять, но судя по коду никакого отношения к "при пустом значении ячейке в колонке B (не желтой ячейки)," этот код не имеет.

@caustic · 01.11.2012, 16:12 **[ТС]**

Сообщение от Alex77755

Без файла трудно понять, но судя по коду никакого отношения к "при пустом значении ячейке в колонке B (не желтой ячейки)," этот код не имеет.

я дико извиняюсь, не ту часть кода скопировал:

(и макрос относится к файлу из первого поста)

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
    SM = Cells(3, 2)
St = Cells(3, 2)
 
lr = Cells(Rows.Count, 1).End(xlUp).Row + 1
For r = 4 To lr
    If Cells(r, 1).Interior.ColorIndex = 6 Then
       Cells(r, 8) = Cells(r, 2) / SM
       St = Cells(r, 2)
    Else
       Cells(r, 8) = Cells(r, 2) / St
    End If
Next r

@Alex77755 · 01.11.2012, 16:16

Я уже удалил файл-пример, но
надо добавить проверку на пустоту

Новые блоги и статьи Все статьи Все блоги /
Модель здравосоХранения 6. ESG-повестка и устойчивое развитие; углублённый анализ кадрового бренда anaschu 31.03.2026 В прикрепленном документе раздумья о том, как можно поменять модель в будущем	10 пpимет, которые всегда сбываются Maks 31.03.2026 1. Чтобы, наконец, пришла маршрутка, надо закурить. Если сигарета последняя, маршрутка придет еще до второй затяжки даже вопреки расписанию. 2. Нaдоели зима и снег? Не надо переезжать. Достаточно. . .	Перемещение выделенных строк ТЧ из одного документа в другой Maks 31.03.2026 Реализация из решения ниже выполнена на примере нетипового документа "ВыдачаОборудованияНаСпецтехнику" с единственной табличной частью "ОборудованиеИКомплектующие" разработанного в конфигурации КА2. . . .	Functional First Web Framework Suave DevAlt 30.03.2026 Sauve. IO Апнулись до NET10. Из зависимостей один пакет, работает одинаково хорошо как в режиме проекта так и в интерактивном режиме. из сложностей - чисто функциональный подход. Решил. . .
Автоматическое создание документа при проведении другого документа Maks 29.03.2026 Реализация из решения ниже выполнена на нетиповых документах, разработанных в конфигурации КА2. Есть нетиповой документ "ЗаявкаНаРемонтСпецтехники" и нетиповой документ "ПланированиеСпецтехники". В. . .	Настройка движения справочника по регистру сведений Maks 29.03.2026 Решение ниже реализовано на примере нетипового справочника "ТарифыМобильнойСвязи" разработанного в конфигурации КА2, с целью учета корпоративной мобильной связи в коммерческом предприятии. . . .	Автозаполнение реквизита при выборе элемента справочника Maks 27.03.2026 Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. При выборе "Спецтехники" (Тип Справочник. Спецтехника), заполняется. . .	Сумматор с применением элементов трёх состояний. Hrethgir 26.03.2026 Тут. https:/ / fips. ru/ EGD/ ab3c85c8-836d-4866-871b-c2f0c5d77fbc Первый документ красиво выглядит, но без схемы. Это конечно не даёт никаких плюсов автору, но тем не менее. . . всё может быть. . .

@Апострофф 9908 / 3924 / 742 Регистрация: 11.10.2011 Сообщений: 5,907
	01.11.2012, 08:04
	caustic, ошибка происходит из-за незаданного r (=0?). Это одно из следствий игнорирования Option Ecplicit 0

@Alex77755 11525 / 3812 / 683 Регистрация: 13.02.2009 Сообщений: 11,229
	01.11.2012, 16:07
	caustic, Без файла трудно понять, но судя по коду никакого отношения к "при пустом значении ячейке в колонке B (не желтой ячейки)," этот код не имеет. 0

@Alex77755 11525 / 3812 / 683 Регистрация: 13.02.2009 Сообщений: 11,229
	01.11.2012, 16:16
	Я уже удалил файл-пример, но надо добавить проверку на пустоту 0