VBA левая функция?

Question

Я относительно новичок в VBA и у меня есть некоторый написанный код, который, кажется, должен быть простым, но ведет себя не так, как ожидалось. Я пытаюсь разделить мой основной рабочий лист (GAWi) на три другие рабочие листы (LWi, WMi и OTi) на основе первой буквы в столбце H. В основном, если первая буква - «L», я хочу, чтобы эта строка была скопирована и вставлена на лист LWi, а затем удален из исходного листа. Затем, если это W, он идет на WMi, а если это A, он идет на OTi. Он работает правильно для первых двух операторов If (размещение элементов, начинающихся с L & W, на правильные листы), но для последних элементов, которые начинаются с P и 0, также помещаются на лист OTi. Я в полной растерянности, это кажется довольно простым, и я не могу понять, где я ошибся. Будем очень благодарны за любые советы, и я уверен, что этот код довольно неликвиден по большинству стандартов, поэтому любые советы о том, как его сократить, также будут приветствоваться - я только начал работать с VBA в последние пару недель. Большое спасибо!

  Sheets("GAWi").Select
    Columns("H:H").Select
    Dim lwr As Range
    Set lwr = ActiveSheet.UsedRange
        For i = lwr.Cells.Count To 1 Step -1
        If Left(lwr.Item(i).Value, 1) = "L" Then
            lwr.Item(i).EntireRow.copy
            Sheets("LWi").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            ActiveCell.Offset(1, 0).Select
            Sheets("GAWi").Select
            lwr.Item(i).EntireRow.Delete
    End If
        If Left(lwr.Item(i).Value, 1) = "W" Then
            lwr.Item(i).EntireRow.copy
            Sheets("WMi").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            ActiveCell.Offset(1, 0).Select
            Sheets("GAWi").Select
            lwr.Item(i).EntireRow.Delete
    End If
        If Left(lwr.Item(i).Value, 1) = "A" Then
            lwr.Item(i).EntireRow.copy
            Sheets("OTi").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            ActiveCell.Offset(1, 0).Select
            Sheets("GAWi").Select
            lwr.Item(i).EntireRow.Delete
    End If   Next i

Answer 1

в вашей логике есть главный недостаток c: использование UsedRange

, несмотря на то, что это 2D-диапазон, его свойство Item() будет действовать так, как если бы это был одномерный массив с одной строкой после другого списка

, поэтому для «A1: H10» (восемь столбцов) адрес UsedRange, UsedRange.Item(1) будет указывать на «A1», UsedRange.Item(8) будет указывать на «H1» и UsedRange.Item(9) будет указывать на "A2" ...

, поэтому вам нужно l oop только через ячейки столбца H

Тогда есть недостаток кодирования, который использует все эти Select / Selection: привычка всегда использовать явную ссылку на диапазон, соответствующую их родительскому рабочему листу и рабочей книге. Это может быть достигнуто, например, с использованием With... End With construct

, вот возможный код (пояснения в комментариях):

Option Explicit

Sub TransferRows()
    Dim i As Long

    With Sheets("GAWi") ' reference "source" sheet
        For i = .Cells(.Rows.Count, "H").End(xlUp).Row To 1 Step -1 ' loop backwards from referenced sheet column H last not empty cell row index to 1
            Select Case UCase(.Cells(i, "H").Value) ' check for referenced sheet column H current row content
                Case "L"
                    TransferRow Intersect(.UsedRange, .Rows(i)), Sheets("LWi") ' pass referenced sheet current row "used" range and "LWi" destination sheet to the helper sub
                Case "W"
                    TransferRow Intersect(.UsedRange, .Rows(i)), Sheets("WMi") ' pass referenced sheet current row "used" range and "WMi" destination sheet to the helper sub
                Case "A"
                    TransferRow Intersect(.UsedRange, .Rows(i)), Sheets("OTi") ' pass referenced sheet current row "used" range and "OTi" destination sheet to the helper sub
            End Select
        Next i
    End With
End Sub

Sub TransferRow(sourceRng As Range, destSht As Worksheet)
    With destSht
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, sourceRng.Columns.Count).Value = sourceRng.Value
    End With
    sourceRng.Delete xlUp
End Sub

Как видите, кроме поправок к предисловиям, которые я здесь привожу:

• использование синтаксиса Select Case вместо If Then End If

  , который, как мне кажется, гораздо понятнее и также исправит незначительные логики c недостаток вашего оригинального кода: если проверка положительна, другие запускать не нужно (это вы могли бы получить с помощью конструкции If - Then - ElseIf - Endif)

• использование вспомогательного подпрограммы для запроса повторяющегося кода на

  , что дает вам гораздо больший контроль над вашим кодом и помогает его обслуживанию

• использование ячеек (строк .Count, colIndex) .End (xlUp) шаблон

  , который наиболее часто используется для получения ссылки на последнюю непустую ячейку в некотором colIndex (будь то число или буква) столбце

Answer 2

Благодаря отличному отклику HTH я смог немного почистить свой код и подумать, что понял его. Я решил придерживаться формата If Then Else If, так как я пока не слишком знаком с использованием Case. Вот первый раздел, я просто повторил copy, paste, delete row для каждой начальной буквы.

Set rng = Range("GAWi!H:H")
        For k = rng.Cells.Count To 1 Step -1

            If Left(rng.Item(k).Value, 1) = "W" Then
                With rng.Item(k)
                    .EntireRow.copy
                    Sheets("WMi").Activate
                    ActiveCell.Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    .EntireRow.Delete
                End With

                ElseIf Left(rng.Item(k).Value, 1) = "L" Then....

Это хорошо для моих целей, но если у кого-то есть больше предложений, они очень ценятся.