VBA左功能？

Question

我对VBA还是比较陌生，我写了一些代码，看起来应该很简单，但表现却不符合预期。我试图基于H列中的第一个字母将主工作表（GAWi）分为其他三个工作表（LWi，WMi和OTi）。基本上，如果第一个字母为“ 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

您的逻辑中存在一个主要缺陷：UsedRange的使用>

尽管是2D范围，但其Item()属性的作用就像是一维数组，其中一行依次列出

因此是“ A1：H10”（八列），UsedRange的地址，UsedRange.Item(1)指向“ A1”，UsedRange.Item(8)指向“ H1”，UsedRange.Item(9)指向“ A2” …

所以您只需要遍历H列的单元格

然后有一个编码缺陷，即使用所有这些Select / Selection：养成总是

的习惯，使用明确的范围引用限定其父级工作表和工作簿。例如，可以使用With... End With构造

这是可能的代码（注释中的解释）：

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

  我认为这更清楚，并且可以纠正原始代码的一个逻辑小缺陷：一旦检查通过，就不再需要运行其他检查了（您可以通过If - Then - ElseIf - Endif构造获得此]

  ] >

• 使用“帮助器”子项要求重复代码至

  这使您对代码有更多的控制权，并有助于代码的维护