Макрос VBA: выбор листов и удаление строк на основе условия - PullRequest
0 голосов
/ 12 ноября 2018

Я пытаюсь написать макрос VBA, но я новичок в этом. (А я немец, извините за мой плохой английский). Я нашел несколько полезных фрагментов кода здесь, в StackOverflow, но я не могу адаптировать его для своих потребностей. У меня есть рабочая тетрадь с несколькими листами, и некоторые из них имеют одинаковую структуру. В этих листах в столбце C у всех есть дата. Макрос должен выглядеть на этих листах, если дата похожа на «00.01.1900», а затем удалить эту строку. Я попробовал две версии, но ни одна из них не сработала. Это просто ничего не произошло, так что, возможно, прохождение листов не так? Или совпадение строк не работает?

Версия 1:

    Dim str As String, w As Long, m As Variant, wss As Variant


        wss = Array("Schritt3-WEA1", "Schritt3-WEA2", "Schritt3-WEA3", "Schritt3-WEA4", _
            "Schritt3-WEA5", "Schritt3-WEA6", "Schritt3-WEA7", "Schritt3-WEA8", "Schritt3-WEA9" _
            , "Schritt3-WEA15", "Schritt3-WEA16", "Schritt3-WEA17", "Schritt3-WEA18", _
            "Schritt3-WEA19", "Schritt3-WEA20", "Schritt3-WEA21", "Schritt3-WEA22", _
            "Schritt3-WEA23", "Schritt3-WEA28", "Schritt3-WEA29", "Schritt3-WEA36")
        str = "00.01.1900"
        If CBool(Len(str)) And str <> "False" Then
            With ThisWorkbook
                For w = LBound(wss) To UBound(wss)
                    With .Worksheets(wss(w))

                        m = Application.Match(str, .Columns(3), 0)
                        Do While Not IsError(m)
                            .Cells(m, "A").EntireRow.Delete
                            m = Application.Match(str, .Columns(3), 0)
                        Loop
                    End With
                Next w
             End With
        End If

Версия 2:

        Dim wks As Worksheet
        Dim arrSheets As Variant
        Dim iShCount As Integer
        arrSheets = Array("Schritt3-WEA1", "Schritt3-WEA2", "Schritt3-WEA3", "Schritt3-WEA4", _
            "Schritt3-WEA5", "Schritt3-WEA6", "Schritt3-WEA7", "Schritt3-WEA8", "Schritt3-WEA9" _
            , "Schritt3-WEA15", "Schritt3-WEA16", "Schritt3-WEA17", "Schritt3-WEA18", _
            "Schritt3-WEA19", "Schritt3-WEA20", "Schritt3-WEA21", "Schritt3-WEA22", _
            "Schritt3-WEA23", "Schritt3-WEA28", "Schritt3-WEA29", "Schritt3-WEA36")
        For Each wks In Worksheets
            For iShCount = 0 To UBound(arrSheets)
                If wks.Name = arrSheets(iShCount) Then
                    '** Ermittlung der letzten Zeile in Spalte C
                    lz = Cells(Rows.Count, 3).End(xlUp).Rows.Row
                    '** Durchlauf aller Zeilen
                    For t = lz To 15 Step -1
                    'Z?hlung r?ckw?rts bis Zeile 15
                    'Abfragen, ob in der dritten Spalte "00.01.1900" steht
                        If Cells(t, 3).Value = "00.01.1900" Then
                            Rows(t).Delete Shift:=xlUp
                        End If
                    Next t
                End If
            Next
        Next

Большое спасибо заранее!

Ответы [ 3 ]

0 голосов
/ 12 ноября 2018

Редактировать: изменили .value на .value2 и вставили «Выход для»

Большое спасибо, теперь это работает:

Dim wks As Worksheet
Dim arrSheets As Variant
Dim iShCount As Integer
arrSheets = Array("Schritt3-WEA1", "Schritt3-WEA2", "Schritt3-WEA3", "Schritt3-WEA4", _
    "Schritt3-WEA5", "Schritt3-WEA6", "Schritt3-WEA7", "Schritt3-WEA8", "Schritt3-WEA9" _
    , "Schritt3-WEA15", "Schritt3-WEA16", "Schritt3-WEA17", "Schritt3-WEA18", _
    "Schritt3-WEA19", "Schritt3-WEA20", "Schritt3-WEA21", "Schritt3-WEA22", _
    "Schritt3-WEA23", "Schritt3-WEA28", "Schritt3-WEA29", "Schritt3-WEA36")
For Each wks In Worksheets
    For iShCount = 0 To UBound(arrSheets)
        If wks.Name = arrSheets(iShCount) Then
            '** Ermittlung der letzten Zeile in Spalte C
            lz = wks.Cells(Rows.Count, 3).End(xlUp).Rows.Row
            '** Durchlauf aller Zeilen
            For t = lz To 15 Step -1
            'Z?hlung r?ckw?rts bis Zeile 15
            'Abfragen, ob in der dritten Spalte "00.01.1900" steht
                If wks.Cells(t, 3).Value2 = 0 Then
                    wks.Rows(t).Delete Shift:=xlUp
                End If
            Next t
            Exit For
        End If
    Next
Next
0 голосов
/ 12 ноября 2018

Предполагая, что ваш столбец данных C содержит реальные даты (а не строки), используйте ваш второй вариант, но проверьте (числовое) значение 0. Строка "00.01.1900" является представлением (зависит от языка) для 0 в качестве даты.

Обязательно получите доступ к Cells(t, 3).Value2 (не Value, поскольку это вернет строку, когда ячейка отформатирована как Date). См. В чем разница между .text, .value и .value2? для некоторых деталей.

Обратите внимание, что когда вы перебираете данные с целью удалить некоторые из них, вам всегда следует работать в обратном направлении (как во втором примере), иначе вы рискуете пропустить некоторые: допустим, вы удалите строку 3, а затем предыдущую строку 4 получит новую строку 3, но ваш цикл продолжит проверку строки 4 - прежняя строка 4 (а теперь строка 3) никогда не будет проверена.

0 голосов
/ 12 ноября 2018

Перейдите в «Домой» и выберите одну из ячеек 00.01.1900 и измените ее формат с даты на общую. Вы видите, что она становится 0?

Нужно знать, хранится ли в ячейке значение 0или текст «00.01.1900»

Если он изменится на 0, просто используйте код версии 2, но измените строку ниже (с «00.01.1900» на 0)

If Cells(t, 3).Value = 0 Then
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...