VBA, как оптимизировать макрос для многих столбцов - PullRequest
0 голосов
/ 25 июня 2018

Я хочу написать макрос для условного подсчета строк в столбцах, у меня около 30 столбцов, я хотел бы иметь один макрос для всех возможных столбцов.Я пишу макрос для одного столбца, но не знаю, как их оптимизировать.Мой макрос для первого столбца (110_1.1) ниже.И мне нужно написать макрос для следующих столбцов "120_1.2", "130_1.3", ... и т. Д. До "810_8.1" и, следовательно, Sheets ("Element_errors"). Ячейки (i, j)должен принимать значения "err120", "err130", .. "err810" и j = 1,30 для каждого столбца.И проблема в том, что все столбцы не идут один за другим.

 Sub Element110_error()
    Dim zelle As Range
    Dim i As Integer
    Dim posMonitoring As Integer
    Dim j As Integer
    Dim intLastRow As Integer

    With Sheets("ICS Table")
     intLastRow = .UsedRange.Rows.Count
    Set zelle = .Cells.Find("110_1.1", lookat:=xlPart)

    If zelle Is Nothing Then
        For i = 2 To intLastRow
            Sheets("Element_errors").Cells(i, 1).Value = "no data"
        Next i
    Else
        posMonitoring = zelle.Column

        For i = 2 To intLastRow
            If .Cells(i, posMonitoring).Value < 1 Or .Cells(i, posMonitoring).Value > 10 Then
                Sheets("Element_errors").Cells(i, 1) = "err110"
            Else
                Sheets("Element_errors").Cells(i, 1) = "no"
            End If
        Next i


      End If
    End With
End Sub

1 Ответ

0 голосов
/ 25 июня 2018

это будет повторять каждый шаблон и выводить столбец для каждого:

Sub Element110_error()
    Dim zelle As Range
    Dim i As Long
    Dim posMonitoring As Integer
    Dim j As Long
    Dim intLastRow As Integer
    k = 0
    With Sheets("ICS Table")
        intLastRow = .UsedRange.Rows.Count
        For j = 11 To 81
            Dim fnd As String
            fnd = j & "0_" & Left(j, 1) & "." & Right(j, 1)
            Set zelle = .Cells.Find(fnd, lookat:=xlPart)
            Sheets("Element_errors").Cells(1, j - 10).Value = fnd
            If zelle Is Nothing Then
                For i = 2 To intLastRow
                    Sheets("Element_errors").Cells(i, j - 10).Value = "no data"
                Next i
            Else
                posMonitoring = zelle.Column
                For i = 2 To intLastRow
                    If .Cells(i, posMonitoring).Value < 1 Or .Cells(i, posMonitoring).Value > 10 Then
                        Sheets("Element_errors").Cells(i, j - 10) = "err" & j & "0"
                    Else
                        Sheets("Element_errors").Cells(i, j - 10) = "no"
                    End If
                Next i


            End If
        Next j
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...