Как создать несколько переменных в al oop и присвоить значения в VBA

Question

У меня есть таблица Excel с несколькими тысячами строк данных, которые разбиты на несколько разделов в зависимости от Менеджера. Я создал код, который скрывает любые строки с нулевым значением в пределах диапазона для отдельных разделов, но они работают медленно, и я не уверен, есть ли более быстрый способ достичь того же результата. Вот что у меня есть на данный момент:

    Option Explicit

    Public shp As Single
    Public r1 As Single
    Public r23 As Single
    Public sFind as String

1-я часть кодирования, которая обозначает строки, которые будут прокручиваться внутри группы менеджеров. У меня есть кнопка для каждого менеджера и дополнительная кнопка с # _Click () до go с каждым разделом данных. Ниже приведен пример кнопки № 1, каждая из которых выглядит одинаково, за исключением того, что номера строк отличаются.

    Sub Button1_Click()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    shp = 6
    r1 = 14
    r23 = 36

    Call Button_Macro

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

Приведенный выше код вызывает следующий код для запуска:

    Sub Button_Macro()

    Dim r as Single
    Dim x as Single
    Dim i as Single
    Dim MyArray as Variant
    Dim ShpName as String

    ShpName = "Rounded Rectangle " & Shp
    ActiveSheet.Shapes.Range(ShpName).Select
    sFind = Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text

    If sFine = "-" Then
         ActiveSheet.Shapes.Range(Array(ShpName)).Select
         Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "+"
              Rows(r1 & ":" & r23).Hidden = True
    Else
         ActiveSheet.Shapes.Range(Array(ShpName)).Select
         Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "-"

         Rows(r1 & ":" & r23).Hidden = False

         MyArray = Range(Cells(r1,4), Cells(r23,6)).Value

              r = 1
              x = r1
              For i = r1 to r23
                   If MyArray(r,1) + MyArray(r,2) + MyArray(r,3) = 0 Then
                        Rows(x).EntireRow.Hidden = True
                   End If
              x = x + 1
              r = r + 1
              Next i
    End If

    Cells(r1 - 1, 2).Select

    End Sub

Рядом с В каждом разделе данных есть кнопка со знаком +, когда все строки в разделе Менеджера скрыты, затем, когда вы нажимаете кнопку, запускается код и меняет текст кнопки на - и отображаются только строки со значениями больше нуля. Когда я нажимаю кнопку, запуск кода занимает около 10 секунд. Я знаю, что это звучит не так уж и много, но люди ожидают, что, когда они нажмут кнопку, строки со значениями должны появиться сразу, а не через 10 секунд, поэтому я пытаюсь выяснить, есть ли более быстрый способ кодирования этого. Спасибо.

Answer 1

Пожалуйста, замените свой l oop на этот. Ваш запутанный и выполняется много-много раз.

For R = R1 To R23
    Myarray = Range(Cells(R, 4), Cells(R, 6)).Value
    If MyArray(1, 1) + MyArray(1, 2) + MyArray(1, 3) = 0 Then
         ActiveSheet.Rows(R).EntireRow.Hidden = True
    End If
Next R

Обратите внимание, что номера строк и столбцов должны содержаться в переменных типа данных Long. Этого достаточно, потому что они никогда не будут содержать дроби, с которыми Longs не справится.

Answer 2

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

Sub ShowHide_Click()
    ' 020

    Dim Ws As Worksheet
    Dim Button As Shape
    Dim ButtonName As String, NextName As String
    Dim ButtonID As Integer
    Dim ShowRows As Boolean                     ' True if "+" was clicked
    Dim Rstart As Long, Rend As Long            ' rows to hide
    Dim RowRange As Range
    Dim Arr As Variant
    Dim R As Long

    Set Ws = ActiveSheet                        ' better name the sheet

    ' get the name of the button that was pressed
    ButtonName = Application.Caller
    Set Button = Ws.Shapes(ButtonName)

    ' read and reset the button
    With Button.TextFrame.Characters
        ShowRows = .Text = "+"
        .Text = IIf(ShowRows, "-", "+")
    End With

    ' assume the first row to hide will be 1 row below the button
    Rstart = Button.TopLeftCell.Row + 1

    ' extract the ID from the name
    Do
        NextName = Right(ButtonName, ButtonID)
        ButtonID = ButtonID + 1
        If ButtonID >= Len(ButtonName) Then Exit Sub
        If Not IsNumeric(Right(ButtonName, ButtonID)) Then Exit Do
    Loop
    ButtonID = Val(NextName)

    ' name the next button in serial sequence
    NextName = Trim(Left(ButtonName, Len(ButtonName) - Len(NextName))) _
                  & Str(ButtonID + 1)
    With Ws
        ' this test will return False if Shape(NextName) doesn't exist
        If .Shapes(NextName).Name = NextName Then
            ' this presumes that the last row to be hidden will be the one
            ' just above the next button's TopLeftCell.
            Rend = .Shapes(NextName).TopLeftCell.Row - 1
        Else
            ' the specified button wasn't found
            ' change column is column B isn't dominant in this regard
            Rend = .Cells(Ws.Rows.Count, "B").End(xlUp).Row
        End If

        ' set the range attached to the button
        Set RowRange = .Range(.Rows(Rstart), .Rows(Rend))

        ' show or hide rows
        RowRange.Rows.EntireRow.Hidden = Not ShowRows
        If ShowRows Then
            For R = Rstart To Rend
                Arr = Ws.Range(Cells(R, 4), Cells(R, 6)).Value
                Ws.Rows(R).EntireRow.Hidden = (Arr(1, 1) + Arr(1, 2) + Arr(1, 3) = 0)
            Next R

        '    ' consider this alternative (Delete Dim Arr if you choose this)
        '    For R = Rstart To Rend
        '        Ws.Rows(R).EntireRow.Hidden = (Application.Count(Ws.Range(Cells(R, 4), Cells(R, 6))) = 0)
        '    Next R
        End If

        .Cells(Rstart, "B").Select
    End With
End Sub

Я добавил много комментариев к коду, чтобы показать, как работает код и как настроить его для работы с вашим листом. Однако существует несколько условий, которым должен соответствовать ваш рабочий лист.

1. Все кнопки должны быть одного типа, например «Прямоугольник со скругленными углами».
2. Они должны быть пронумерованы последовательно. Цифры не должны начинаться с 1 (хотя я не понимаю, почему они не должны), но они должны быть пронумерованы последовательно сверху вниз. Вы не можете добавить кнопку посередине, например 1, 2, 3, 7, 4, 5, 6. Нумерация должна быть 1, 2, 3, 4, 5, 6, 7.

Answer 3

Проверьте, есть ли формулы, основанные только на видимых ячейках, затем переведите Calculation в ручной режим в начале и обратно в автоматический c в конце. В противном случае он будет повторно вычислять при скрытии каждой строки.

---

Обратите внимание, что вместо использования этих Public переменных

Public shp As Single
Public r1 As Single
Public r23 As Single
Public sFind as String

вы должны указать их в качестве параметров вашей процедуры. Также номера строк имеют тип Long не Single и sFind должны быть локальной переменной Button_Macro, а не Public:

Option Explicit

Public Sub Button_Macro(ByVal shp As Long, ByVal r1 As Long, ByVal r23 As Long)

    Dim sFind as String

    'your code here …

End Sub

И называть это как

Public Sub Button1_Click()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Button_Macro shp:=6, r1:=14, r23:=36

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

---

В этой части я бы рекомендовал прекратить использование нескольких счетчиков, поскольку все они зависят друг от друга, следующее

r = 1
x = r1

For i = r1 to r23
    If MyArray(r,1) + MyArray(r,2) + MyArray(r,3) = 0 Then
        Rows(x).EntireRow.Hidden = True
    End If

    x = x + 1
    r = r + 1
Next i

может быть записано как

Dim i As Long   'i must be long too
For i = r1 to r23
    If MyArray(i-(r1-1),1) + MyArray(i-(r1-1),2) + MyArray(i-(r1-1),3) = 0 Then
        Rows(i).EntireRow.Hidden = True
    End If
Next i