Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Проставить формулы по значению в ячейке. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Проставить формулы по значению в ячейке. (Макросы Sub)
Проставить формулы по значению в ячейке.
SkyPro Дата: Суббота, 04.01.2014, 16:38 | Сообщение № 1
Группа: Друзья
Ранг: Старожил
Сообщений: 1206
Репутация: 255 ±
Замечаний: 0% ±

2010
Добрый день, друзья.
Необходима ваша помощь.
Есть столбец с числами (в виде структуры)
1
2
3
3
2
3
3
3
1
2
3
3
.. и т.д.

Необходимо программно проставить формулы СУММ в зависимости от значения в ячейках (в примере проставил как должно быть)
Если 1, то суммируем все двойки до следующей единицы или конца списка.
Если 2, то суммируем все тройки до следующей двойки или до конца списка или до единицы.

Буду признателен за помощь или подсказку.
К сообщению приложен файл: formulawithvba.xls (31.0 Kb)


skypro1111@gmail.com

Сообщение отредактировал SkyPro - Суббота, 04.01.2014, 16:39
 
Ответить
СообщениеДобрый день, друзья.
Необходима ваша помощь.
Есть столбец с числами (в виде структуры)
1
2
3
3
2
3
3
3
1
2
3
3
.. и т.д.

Необходимо программно проставить формулы СУММ в зависимости от значения в ячейках (в примере проставил как должно быть)
Если 1, то суммируем все двойки до следующей единицы или конца списка.
Если 2, то суммируем все тройки до следующей двойки или до конца списка или до единицы.

Буду признателен за помощь или подсказку.

Автор - SkyPro
Дата добавления - 04.01.2014 в 16:38
ikki Дата: Суббота, 04.01.2014, 16:57 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1906
Репутация: 504 ±
Замечаний: 0% ±

Excel 2003, 2010
добрый днгь.
Необходимо программно проставить формулы СУММ
именно так?

я как-то решал похожую задачку, но немного иначе.
http://www.planetaexcel.ru/forum....D=40543
(после первого поста можно сразу смотреть последний)


помощь по Excel и VBA
ikki@fxmail.ru, icq 592842413, skype alex.ikki


Сообщение отредактировал ikki - Суббота, 04.01.2014, 17:03
 
Ответить
Сообщениедобрый днгь.
Необходимо программно проставить формулы СУММ
именно так?

я как-то решал похожую задачку, но немного иначе.
http://www.planetaexcel.ru/forum....D=40543
(после первого поста можно сразу смотреть последний)

Автор - ikki
Дата добавления - 04.01.2014 в 16:57
SkyPro Дата: Суббота, 04.01.2014, 17:03 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1206
Репутация: 255 ±
Замечаний: 0% ±

2010
именно так?

Угу =(
За ссылку спасибо. Подумаю, мож чего и выйдет. Но в приоритете именно ВБА.


skypro1111@gmail.com
 
Ответить
Сообщение
именно так?

Угу =(
За ссылку спасибо. Подумаю, мож чего и выйдет. Но в приоритете именно ВБА.

Автор - SkyPro
Дата добавления - 04.01.2014 в 17:03
ikki Дата: Суббота, 04.01.2014, 17:25 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1906
Репутация: 504 ±
Замечаний: 0% ±

Excel 2003, 2010
как вариант
[vba]
Код
Sub t()
       x = [A1:A26].Value
       For i = UBound(x) To 1 Step -1
           Select Case x(i, 1)
               Case 3: txt2 = txt2 & ",b" & i
               Case 2: txt1 = txt1 & ",b" & i
                       If txt2 > "" Then Cells(i, "b").Formula = "=sum(" & Mid(txt2, 2) & ")": txt2 = ""
               Case 1: txt2 = ""
                       If txt1 > "" Then Cells(i, "b") = "=sum(" & Mid(txt1, 2) & ")": txt1 = "": txt2 = ""
           End Select
       Next
End Sub
[/vba]

пс. вариант чисто учебный - в реальной жизни есть риск нарваться на ограничения по количеству аргументов функции


помощь по Excel и VBA
ikki@fxmail.ru, icq 592842413, skype alex.ikki


Сообщение отредактировал ikki - Суббота, 04.01.2014, 17:36
 
Ответить
Сообщениекак вариант
[vba]
Код
Sub t()
       x = [A1:A26].Value
       For i = UBound(x) To 1 Step -1
           Select Case x(i, 1)
               Case 3: txt2 = txt2 & ",b" & i
               Case 2: txt1 = txt1 & ",b" & i
                       If txt2 > "" Then Cells(i, "b").Formula = "=sum(" & Mid(txt2, 2) & ")": txt2 = ""
               Case 1: txt2 = ""
                       If txt1 > "" Then Cells(i, "b") = "=sum(" & Mid(txt1, 2) & ")": txt1 = "": txt2 = ""
           End Select
       Next
End Sub
[/vba]

пс. вариант чисто учебный - в реальной жизни есть риск нарваться на ограничения по количеству аргументов функции

Автор - ikki
Дата добавления - 04.01.2014 в 17:25
SkyPro Дата: Суббота, 04.01.2014, 17:34 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 1206
Репутация: 255 ±
Замечаний: 0% ±

2010
Спасибо!
Именно то, что нужно.
Сейчас еще "просклоняю" и допилю под свои потребности.


skypro1111@gmail.com
 
Ответить
СообщениеСпасибо!
Именно то, что нужно.
Сейчас еще "просклоняю" и допилю под свои потребности.

Автор - SkyPro
Дата добавления - 04.01.2014 в 17:34
nilem Дата: Суббота, 04.01.2014, 18:07 | Сообщение № 6
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
как вариант
[vba]
Код
Sub ertert()
Dim x, i&, j&, k&, n&
With Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row)
     .Columns(2).ClearContents: x = .Value
     For i = 1 To UBound(x)
         If x(i, 1) > 0 Then
             n = x(i, 1): k = i: j = i
             Do
                 j = j + 1: If j > UBound(x) Then Exit Do
                 If x(j, 1) = n + 1 Then x(k, 2) = IIf(Len(x(k, 2)), x(k, 2) & ",A" & j, "=SUM(A" & j)
             Loop While x(j, 1) <> n
             If Len(x(k, 2)) Then x(k, 2) = x(k, 2) & ")"
         End If
     Next i
     .Value = x
End With
End Sub
[/vba]


Яндекс.Деньги 4100159601573
 
Ответить
Сообщениекак вариант
[vba]
Код
Sub ertert()
Dim x, i&, j&, k&, n&
With Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row)
     .Columns(2).ClearContents: x = .Value
     For i = 1 To UBound(x)
         If x(i, 1) > 0 Then
             n = x(i, 1): k = i: j = i
             Do
                 j = j + 1: If j > UBound(x) Then Exit Do
                 If x(j, 1) = n + 1 Then x(k, 2) = IIf(Len(x(k, 2)), x(k, 2) & ",A" & j, "=SUM(A" & j)
             Loop While x(j, 1) <> n
             If Len(x(k, 2)) Then x(k, 2) = x(k, 2) & ")"
         End If
     Next i
     .Value = x
End With
End Sub
[/vba]

Автор - nilem
Дата добавления - 04.01.2014 в 18:07
ikki Дата: Суббота, 04.01.2014, 19:11 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 1906
Репутация: 504 ±
Замечаний: 0% ±

Excel 2003, 2010
риск нарваться на ограничения по количеству аргументов функции

вариант со сниженным риском (да и просто с диапазонами красивше как-то :) )
[vba]
Код
Sub t()
      Dim r1 As Range, r2 As Range, x(), i&
      x = [A1:A26].Value
      For i = UBound(x) To 1 Step -1
          Select Case x(i, 1)
              Case 3: If r2 Is Nothing Then Set r2 = Cells(i, 2) Else Set r2 = Union(Cells(i, 2), r2)
              Case 2
                  If r1 Is Nothing Then Set r1 = Cells(i, 2) Else Set r1 = Union(Cells(i, 2), r1)
                  If Not r2 Is Nothing Then Cells(i, 2) = "=sum(" & r2.Address(0, 0) & ")": Set r2 = Nothing
              Case 1
                  Set r2 = Nothing
                  If Not r1 Is Nothing Then Cells(i, 2) = "=sum(" & r1.Address(0, 0) & ")": Set r1 = Nothing
          End Select
      Next
End Sub
[/vba]


помощь по Excel и VBA
ikki@fxmail.ru, icq 592842413, skype alex.ikki


Сообщение отредактировал ikki - Суббота, 04.01.2014, 19:13
 
Ответить
Сообщение
риск нарваться на ограничения по количеству аргументов функции

вариант со сниженным риском (да и просто с диапазонами красивше как-то :) )
[vba]
Код
Sub t()
      Dim r1 As Range, r2 As Range, x(), i&
      x = [A1:A26].Value
      For i = UBound(x) To 1 Step -1
          Select Case x(i, 1)
              Case 3: If r2 Is Nothing Then Set r2 = Cells(i, 2) Else Set r2 = Union(Cells(i, 2), r2)
              Case 2
                  If r1 Is Nothing Then Set r1 = Cells(i, 2) Else Set r1 = Union(Cells(i, 2), r1)
                  If Not r2 Is Nothing Then Cells(i, 2) = "=sum(" & r2.Address(0, 0) & ")": Set r2 = Nothing
              Case 1
                  Set r2 = Nothing
                  If Not r1 Is Nothing Then Cells(i, 2) = "=sum(" & r1.Address(0, 0) & ")": Set r1 = Nothing
          End Select
      Next
End Sub
[/vba]

Автор - ikki
Дата добавления - 04.01.2014 в 19:11
SkyPro Дата: Среда, 08.01.2014, 12:41 | Сообщение № 8
Группа: Друзья
Ранг: Старожил
Сообщений: 1206
Репутация: 255 ±
Замечаний: 0% ±

2010
Спасибо огромное за решения.
Пока использую первый вариант.
Как появится время опробую остальные.


skypro1111@gmail.com
 
Ответить
СообщениеСпасибо огромное за решения.
Пока использую первый вариант.
Как появится время опробую остальные.

Автор - SkyPro
Дата добавления - 08.01.2014 в 12:41
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Проставить формулы по значению в ячейке. (Макросы Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!