Модераторы: Akina
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> За один цикл, xl vba 
:(
    Опции темы
Staruha
Дата 16.12.2004, 12:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1292
Регистрация: 1.2.2004
Где: Казань

Репутация: 2
Всего: 27
Первый цикл очищает нужные ячейки , второй идет по тем же ячейкам и делает расчет. Как сделать за один цикл?
Код

Private Sub CommandButton1_Click()
Dim d As Integer
Dim c As Integer

 d = UsedRange.Rows.Count
 c = UsedRange.Columns.Count
 For RwIndex = 4 To d
For RwIn = 5 To c
             If Cells(RwIndex, RwIn).Value > 0 And Range("A" & RwIndex) > 0 Then
  Range("D" & RwIndex).Value = ""

    End If
  Next RwIn
  Next RwIndex

   For RwIndex = 4 To d
      For RwIn = 5 To c
  If Cells(RwIndex, RwIn).Value > 0 And Range("A" & RwIndex) > 0 Then
 Range("D" & RwIndex).Value = Range("D" & RwIndex).Value + (Cells(3, RwIn).Value * Cell(RwIndex, RwIn).Value)

End If

Next RwIn
Next RwIndex
End Sub

smile


--------------------
Возмездие настигнет
PM MAIL   Вверх
~FoX~
Дата 16.12.2004, 12:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


НЕ рыжий!!!
****


Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 10
Всего: 68
Псевдо код
Код

for c = 1 to n
 for r := 1 to m  
   if cells(c, r).Value = "NeedClear" then call Clear(c, r)
   else call Raschet (cells(c, r).Value)
   end if
 next r
next c




--------------------
user posted image
…множественность никогда не следует полагать без необходимости…
PM MAIL WWW ICQ Jabber   Вверх
boevik
Дата 16.12.2004, 15:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1452
Регистрация: 31.5.2004
Где: Израиль

Репутация: 12
Всего: 35
Код

Private Sub CommandButton1_Click()
Dim d As Integer
Dim c As Integer

d = UsedRange.Rows.Count
c = UsedRange.Columns.Count
For RwIndex = 4 To d
For RwIn = 5 To c
            If Cells(RwIndex, RwIn).Value > 0 And Range("A" & RwIndex) > 0 Then
 Range("D" & RwIndex).Value = Range("D" & RwIndex).Value + (Cells(3, RwIn).Value * Cell(RwIndex, RwIn).Value)


   End If
 Next RwIn
 Next RwIndex

 
End If

Next RwIn
Next RwIndex
End Sub




--------------------
Никогда не говори никогда
PM MAIL WWW   Вверх
Staruha
Дата 16.12.2004, 21:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1292
Регистрация: 1.2.2004
Где: Казань

Репутация: 2
Всего: 27
boevik ...Ну ладно сама виновата. Если я нажму второй раз на такую кнопку ,тогда результат будет не правильный.

Тот верхний код работает.Хотелось бы его облегчить.
Пойду смотреть код FoXа. smile


--------------------
Возмездие настигнет
PM MAIL   Вверх
boevik
Дата 16.12.2004, 21:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1452
Регистрация: 31.5.2004
Где: Израиль

Репутация: 12
Всего: 35
Попробуй такой
Код

Private Sub CommandButton1_Click()
Dim d As Integer
Dim c As Integer

d = UsedRange.Rows.Count
c = UsedRange.Columns.Count
For RwIndex = 4 To d
  If Cells(RwIndex, RwIn).Value > 0 And Range("A" & RwIndex) > 0 Then Range("D" & RwIndex).Value = ""
     For RwIn = 5 To c
        If Cells(RwIndex, RwIn).Value > 0 And Range("A" & RwIndex) > 0 Then
           Range("D" & RwIndex).Value = Range("D" & RwIndex).Value + (Cells(3, RwIn).Value * Cell(RwIndex, RwIn).Value)
        End If
    Next RwIn
 Next RwIndex
End Sub





--------------------
Никогда не говори никогда
PM MAIL WWW   Вверх
Staruha
Дата 16.12.2004, 22:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1292
Регистрация: 1.2.2004
Где: Казань

Репутация: 2
Всего: 27
Код

If Cells(RwIndex, RwIn).

Теперь RwIn начинается до запуска цикла
Код

   For RwIn = 5 To c
 

Вобщем ,если будут идеи заходи.Вопрос не проблемный.
~FoX~ налету не получается.
Нужно что-то вроде этого. Но вовремя выйти из цикла.
Код

Private Sub CommandButton1_Click()
Dim d As Integer
Dim c As Integer

d = UsedRange.Rows.Count
c = UsedRange.Columns.Count
For RwIndex = 4 To d
For RwIn = 5 To c
            If Cells(RwIndex, RwIn).Value > 0 And Range("A" & RwIndex) > 0 Then
 Range("D" & RwIndex).Value = ""
Range("D" & RwIndex).Value = Range("D" & RwIndex).Value + (Cells(3, RwIn).Value * Cell(RwIndex, RwIn).Value)

  End If

Next RwIn
Next RwIndex
End Sub



--------------------
Возмездие настигнет
PM MAIL   Вверх
boevik
Дата 16.12.2004, 22:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1452
Регистрация: 31.5.2004
Где: Израиль

Репутация: 12
Всего: 35
Цитата
Нужно что-то вроде этого. Но вовремя выйти из цикла.

Когда надо выйти из цикла?
Для выхода из цикла команда Exit For.


--------------------
Никогда не говори никогда
PM MAIL WWW   Вверх
Staruha
Дата 17.12.2004, 12:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1292
Регистрация: 1.2.2004
Где: Казань

Репутация: 2
Всего: 27
Нужно очистить ячейку
Range("D" & RwIndex).Value = "" выход из цикла
А потом ее заполнить
Range("D" & RwIndex).Value = Range("D" & RwIndex).Value + (Cells(3, RwIn).Value * Cell(RwIndex, RwIn).Value)

Если делаю вместе то стирается сумма и в результате остается последнее число






--------------------
Возмездие настигнет
PM MAIL   Вверх
boevik
Дата 17.12.2004, 13:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1452
Регистрация: 31.5.2004
Где: Израиль

Репутация: 12
Всего: 35
С использованием Exit For
Код

Private Sub CommandButton1_Click()
Dim d As Integer
Dim c As Integer

d = UsedRange.Rows.Count
c = UsedRange.Columns.Count
For RwIndex = 4 To d
        For RwIn = 5 To c
            If Cells(RwIndex, RwIn).Value > 0 And Range("A" & RwIndex) > 0 Then
                 Range("D" & RwIndex).Value = ""
                 exit for
            End If
        Next RwIn
 Next RwIndex

  For RwIndex = 4 To d
     For RwIn = 5 To c
 If Cells(RwIndex, RwIn).Value > 0 And Range("A" & RwIndex) > 0 Then
Range("D" & RwIndex).Value = Range("D" & RwIndex).Value + (Cells(3, RwIn).Value * Cell(RwIndex, RwIn).Value)

End If

Next RwIn
Next RwIndex
End Sub




С использованием аккумулятора и один цикл
Код

Private Sub CommandButton1_Click()
Dim d As Integer
Dim c As Integer
Dim accumulator as Integer

d = UsedRange.Rows.Count
c = UsedRange.Columns.Count
For RwIndex = 4 To d
        For RwIn = 5 To c
            If Cells(RwIndex, RwIn).Value > 0 And Range("A" & RwIndex) > 0 Then
                 Range("D" & RwIndex).Value = ""
                 accumulator = accumulator + (Cells(3, RwIn).Value * Cell(RwIndex, RwIn).Value)
            End If
        Next RwIn
       if Range("D" & RwIndex).Value = "" then Range("D" & RwIndex).Value = accumulator
 Next RwIndex
End Sub




--------------------
Никогда не говори никогда
PM MAIL WWW   Вверх
Staruha
Дата 17.12.2004, 22:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1292
Регистрация: 1.2.2004
Где: Казань

Репутация: 2
Всего: 27
boevik !!! smile

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

Private Sub CommandButton1_Click()
Dim d As Integer
Dim c As Integer
Dim accumulator As Double
Dim cumulator As Double

d = UsedRange.Rows.Count
c = UsedRange.Columns.Count
For RwIndex = 4 To d
       For RwIn = 5 To c
           If Cells(RwIndex, RwIn).Value > 0 And Range("A" & RwIndex) > 0 Then
                accumulator = accumulator + (Cells(3, RwIn).Value * Cells(RwIndex, RwIn).Value)
                Range("D" & RwIndex).Value = accumulator
           ElseIf Cells(RwIndex, RwIn).Value > 0 And Range("A" & RwIndex) = 0 Then
           k = k + 1
           cumulator = cumulator + Cells(RwIndex, RwIn).Value
           Range("D" & RwIndex).Value = cumulator / k
           End If
       Next RwIn
     
accumulator = 0
cumulator = 0
k = 0
Next RwIndex

End Sub

Это все работает гораздо быстрее .


--------------------
Возмездие настигнет
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "VB6"
Akina

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по VB обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • Используйте теги [code=vb][/code] для подсветки кода. Используйтe чекбокс "транслит" (возле кнопок кодов) если у Вас нет русских шрифтов.

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Akina.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | VB6 | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0510 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.