VBA в XL

G

Макрос в студию!
Будем оптимизировать :lol:

думаю в итоге в 5-10 сек уложимся...

LadyWind

Code:

Sub SAPBEXonRefresh(queryID As String, resultArea As Range)

Dim i, j As Double
Dim RRow, RCol, RRowCount, RColCount As Long
  
  
  RRow = resultArea.Row                 ' начальная строчка вывода области значений
  RCol = resultArea.Column              ' начальный столбец вывода области значений
  RRowCount = resultArea.Rows.Count     ' кол-во строк
  RColCount = resultArea.Columns.Count  ' кол-во столбцов

'в том случае, если данных нет,
' т.е RRowCount = RColCount = 1 - выходим
If resultArea.Rows.Count = 1 Then
    Exit Sub
  End If


'удаляем лишние строки
For i = RRow + 2 To RRow + RRowCount - 1
 If Cells(i, RCol).Value = Cells(i + 1, RCol).Value Then
   For j = i + 1 To RRow + RRowCount
   If Cells(j, RCol).Value <> Cells(i + 1, RCol).Value Then
   Range(Cells(i + 1, RCol), Cells(j - 1, RCol + 20)).Select
   Selection.Delete Shift:=xlUp
    Exit For
   End If
  Next j
 End If
Next i

 
'Результаты
For i = RRow + 1 To RRow + RRowCount - 1

 If Cells(i, RCol + 14).Value <> 0 Then
  Cells(i, RCol + 18).Value = Cells(i, RCol + 15).Value / Cells(i, RCol + 14).Value
  Cells(i, RCol + 18).NumberFormat = "0.00%"
 End If

 If Cells(i, RCol + 15).Value <> 0 Then
  Cells(i, RCol + 19).Value = Cells(i, RCol + 16).Value / Cells(i, RCol + 15).Value
  Cells(i, RCol + 19).NumberFormat = "0.00%"
End If

 If Cells(i, RCol + 15).Value <> 0 Then
  Cells(i, RCol + 20).Value = Cells(i, RCol + 17).Value / Cells(i, RCol + 16).Value
  Cells(i, RCol + 20).NumberFormat = "0.00%"
 End If

Next i

  
End Sub

Типа вот. Виснет кусок "удаляем лишние строки"

G

Я не понял смысла вырезки строк

Можно словами пояснить принцип?
я прогнал скрипт, он работает по разному для подавленных повторяющихся ключей, оставляя по 2 строчки на ключ, а если ключи повторяются, то по одному виду каждого ключа.
И вообще, было бы неплохо, если бы ты подробнее описала что ты хочешь сделать.

LadyWind

Есть отчет

Признак1Знач1 Результат Сумма1+Сумма2+Сумма3
Признак1Знач1 Признак2Знач1 Сумма1
Признак1Знач1 Признак2Знач2 Сумма2
Признак1Знач1 Признак2Знач3 Сумма3
Признак1Знач2 Результат Сумма4+Сумма5
Признак1Знач2 Признак2Знач1 Сумма4
Признак1Знач2 Признак2Знач2 Сумма5

Должно остаться
Признак1Знач1 Результат Сумма1+Сумма2+Сумма3
Признак1Знач2 Результат Сумма4+Сумма5

Просто отчет без Признак2 - не канает, т.к. Сумма1+Сумма2+Сумма3 это не агрегация по кубику, а "Расчет результата как... " суммирование, и первый вариант отчета сделан с условием скрытия некоторых строк.
Использование расчетных и ограниченных показателей нужный результат также не даст.

Vitaly V.V.

может, иерархию сделать?

G

Да, логично, сделать 2 признака как иерархию в дизайнере, а по надобности треугольнички-раскрывалки поудалять нафик...

LadyWind

Нельзя по полит.соображениям.

G

Вот такое сочинилось:

Code:

Dim DelRng As Range

For i = 2 To resultArea.Rows.Count - 1
' Условие для подавленных повтороений ключа
    If resultArea.Cells(i, 1).Value = Empty Then
' Условие для разрешенных повтороений ключа
'    If  resultArea.Cells(i, 1).Value = _
'       resultArea.Cells(i - 1, 1).Value Then
        If DelRng Is Nothing Then
            Set DelRng = resultArea.Rows(i)
        Else
           Set DelRng = Union(resultArea.Rows(i), DelRng)
        End If
    End If
Next i

If Not DelRng Is Nothing Then
   DelRng.Delete Shift:=xlUp
End If

ЗЫ Удаление внутри циклов for делать НЕЛЬЗЯ. А если надо, то только while.

G

LadyWind написала:

Нельзя по полит.соображениям.

а какие политсоображения-то?
пользователь буде в Query Designer'е копаться что ли?

LadyWind

G написал:

LadyWind написала:

Нельзя по полит.соображениям.

а какие политсоображения-то?
пользователь буде в Query Designer'е копаться что ли?

не "будет копаться", а "копается и будет копаться".

G

LadyWind написала:

не "будет копаться", а "копается и будет копаться".

пофик

все-таки САП придуман, чтобы вместо программирования ставить галочку...
вот если бы поставила эту галочку, то не было бы треда на кучу постов и VB-макросов

ЗЫ Стало быстрее работать-то?

LadyWind

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

О результатах тестирования макроса сообщу отдельно.

LadyWind

Собственно говоря, макрос то, что должен делать - не делает. Строки не удаляет :cry:

Насчет

Цитата:

ЗЫ Удаление внутри циклов for делать НЕЛЬЗЯ. А если надо, то только while.

Всегда делала и работало. Только ме-е-едленно

Vitaly V.V.

LadyWind написала:

ме-е-едленно

Может, перед стартом макроса скрывать окно excel, а при окончании - показывать? Макрос должен быстрее отрабатывать...

G

LadyWind написала:

Собственно говоря, макрос то, что должен делать - не делает. Строки не удаляет :cry:

Ну я ж его гонял, тестировал.
Специально, раз уж не признавалась, стоит ли подавление повторяющихся ключей сделал два варианта :cry:

.
Попробуй закоментируй блок

Code:

If resultArea.Cells(i, 1).Value = Empty Then

и раскоментируй

Code:

'    If  resultArea.Cells(i, 1).Value = _
'       resultArea.Cells(i - 1, 1).Value Then n

LadyWind написала:

Насчет

Цитата:

ЗЫ Удаление внутри циклов for делать НЕЛЬЗЯ. А если надо, то только while.

Всегда делала и работало. Только ме-е-едленно

Не верю! (с)
У тебя в отчете, например 100 строк, в цикл for от 1 до 100, если в процессе происходит удаление, то 100 строка вне отчета, но цикл ее обработает. Поэтому и нельзя, поэтому и скорость не при чем.

Vitaly V.V. написал(а):

LadyWind написала:

ме-е-едленно

Может, перед стартом макроса скрывать окно excel, а при окончании - показывать? Макрос должен быстрее отрабатывать...

Лучше делать

Code:

Application.ScreenUpdating = False

и при этом BEx так уже делает заранее, так что дело, все же, в алгоритме.

VBA в XL

Кто сейчас на конференции