2017-02-23 1 views
1

У меня проблема с производительностью в коде VBA-Excel. У меня есть 42 строки и 55 столбцов (можно увеличить). Моя цель состоит в том, чтобы объединить ячейки (в каждых 2 строках), которые имеют одинаковое значение, используя некоторые шаги (я хочу составить диаграмму Ганта).Эффект слияния ячейки превосходит производительность VBA

Before merge

After merge

Первый шаг объединены на колонке на основе (за каждые 2 ряда):

  1. сравнить клеток (строка, столбец) и (строки + 1, Col)
  2. Если у него такое же значение, сравните ячейку (строка, col) и (строка, col + 1)
  3. , если оно имеет такое же значение, сравните ячейку (строка, col + 1) и (строка + 1, col + 1), проверьте следующий столбец и перейдите к шагу 1
  4. , если шаг 2 или 3 является ложным, затем слейте ячейки из первой ячейки (строки, столбца) до последней ячейки, которая имеет одинаковое значение (ячейка (ячейка (ячейка) строка + 1, столбец + п - 1)
  5. , если шаг 1 является ложным, а затем перейти к следующему столбцу

после этого, я должен объединить на основе ряда (по-прежнему для каждых 2 строк).

  1. если ячейка (строка, столбец) и сотовый (строка, столбец + 1), которые не объединены, если ячейка (строка, столбец) и сотовый (строка, столбец + 1), имеют то же значение, перейти к следующий столбец.
  2. , если шаг 1 является ложным, а затем объединить клетки из ячейки (строка, столбец) до ячейки (строка, столбец + п - 1)

Я создал код, приведенный ниже, но я перед лицом производительности вопрос.

Время, необходимое для завершения этого кода, составляет не менее 4 минуты.

Я попытался удалить линию слияния для проверки, и время только 1 секунда.

Я пришел к выводу, что в процессе слияния есть что-то неправильное, но я не мог понять это.

Если у вас есть предложения относительно моего кода, пожалуйста, поделитесь им.

Большое спасибо ...

Sub MergeCell() 
Dim StartTime As Double, RunTime As Double 
StartTime = Timer 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.EnableEvents = False 
Application.DisplayStatusBar = False 
Application.Calculation = xlCalculationManual 

Dim i As Long, j As Long, jmax1 As Long, maxRows As Long, maxCols As Long 
Dim merge As Long, iMerge As Long, jMerge As Long, Jump As Long 
Dim chckst As String 

maxRows = 42 
maxCols = 55 

Dim Rng As Range, Rng3 As Range 
Set Rng = Sheets("Sheet1").Range("E5").Resize(maxRows, maxCols) 
Dim chk As Long 

i = 1 
Do While i < maxRows 
    j = 1 
    Do While j < maxCols 
     iMerge = 0 
     jMerge = 0 
     merge = 0 
     Jump = 0 
     If Rng.Cells(i, j).Value2 = Rng.Cells(i + 1, j).Value2 Then 
      jmax1 = j 
      iMerge = i + 1 
      jMerge = jmax1 
      merge = 1 
      For chk = jmax1 + 1 To maxCols - 1 
       If Rng.Cells(i, j).Value2 = Rng.Cells(i, chk).Value2 Then 
        If Rng.Cells(i, chk).Value2 = Rng.Cells(i + 1, chk).Value2 Then 
         jmax1 = jmax1 + 1 
        Else 
         Jump = 1 
         Exit For 
        End If 
       Else 
        Exit For 
       End If 
      Next 
     Else 
      j = j + 1 
     End If 
     If merge > 0 Then 
      'when I removed this merge line, the speed is good, like I said before 
      Range(Rng.Cells(i, j), Rng.Cells(iMerge, jmax1)).merge 
      j = jmax1 + 1 
      If Jump = 1 Then 
       j = j + 1 
      End If 
     End If 
    Loop 
    i = i + 2 
Loop 

RunTime = Round(Timer - StartTime, 2) 
MsgBox "Run Time = " & RunTime & " seconds", vbInformation 

Dim colId1 As Long, colId2 As Long 
Dim colct As Long 
i = 1 
Do While i <= maxRows 
    j = 1 
    Do While j < maxCols 
     merge = 0 
     jmax1 = j 
     If Rng.Cells(i, jmax1).MergeCells = True Then 
      colct = Rng.Cells(i, jmax1).MergeArea.Columns.Count - 1 
      jmax1 = jmax1 + colct 
      j = jmax1 + 1 
     Else 
      For chk = jmax1 + 1 To maxCols 
       If Rng.Cells(i, j) = Rng.Cells(i, chk) And Rng.Cells(i, chk).MergeCells = False Then 
        merge = 1 
        colId1 = j 
        colId2 = jmax1 + 1 
        If chk <> maxCols Then 
         jmax1 = jmax1 + 1 
        Else 
         j = jmax1 + 1 
         Exit For 
        End If 
       Else 
        j = jmax1 + 1 
        Exit For 
       End If 
      Next 
     End If 
     If merge > 0 Then 
      'when I removed this merge line, the speed is good, like I said before    
      Range(Rng.Cells(i, colId1), Rng.Cells(i, colId2)).merge 
     End If 
    Loop 
    i = i + 1 
Loop 

Rng.HorizontalAlignment = xlCenter 
Rng.VerticalAlignment = xlCenter 

On Error GoTo HERE 
HERE: 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
Application.EnableEvents = True 
Application.DisplayStatusBar = True 
Application.Calculation = xlCalculationAutomatic 

RunTime = Round(Timer - StartTime, 2) 
MsgBox "Done!" & vbNewLine & "Run Time = " & RunTime & " seconds", vbInformation 

End Sub 
+0

Я советую вам прекратить использование Гото в вашем коде. Это невозможно. Можете ли вы опубликовать скриншот своего листа до и после запуска этого кода? – jkpieterse

+0

@jkpieterse Я поставил снимок экрана моего листа до и после. Я модифицировал Goto в цикл For. –

ответ

0

Проблема заключается в условном форматировании.

Мне нужно только удалить условное форматирование перед слиянием, слить его, а затем снова форматировать условное форматирование.

С помощью этого кода все хорошо и быстро. Это всего лишь 2 секунды.

спасибо всем, кто вносит свой вклад в помощь ..

С уважением,

0

Suggestion 1

объявить переменные, как это: Dim i as long, j as long, jmax1 as long, maxRows as long, maxCols as long и т.д. Если вы не укажете тип, они получают объявлен как вариант. В вашей строке объявляется только последняя - Jump. Если вы обновите их, он может работать быстрее.

Suggestion 2

Не использовать целые числа в VBA. переполнение стека.ком/вопросы/26409117/

Suggestion 3

Не используйте GoTohttps://en.wikipedia.org/wiki/Spaghetti_code

Suggestion 4

В общем слияния медленно в VBA/Excel. Но все же, чтобы увидеть, что вы делаете, напишите это до слияния: debug.Print Range(Rng.Cells(i, j), Rng.Cells(iMerge, jmax1)).Address Возможно, вы сливаетесь больше, чем ожидали, или что-то еще.

+0

Я сделал ваше предложение 1 и 2, но нет другого. Для предложения 3 я этого не делал. –

+0

Если вы сделаете третий, ваш код станет понятным, и вы сможете получить хорошую помощь. – Vityata

+1

было применено третье предложение. –

Смежные вопросы