Question

我对VBA非常陌生，我试图将列中的特定项目移动到另一张报告中。

这是我的宏：

Sub DoIHaveaPRDesignation()
   Dim rng As Range
   Dim i, Lastrow
   Dim splitValues() As String

   Lastrow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
   Sheets("Sheet2").Range("A1:I500").ClearContents
   Sheets("Sheet2").Cells(1, 1).Value = "Pair"
   Sheets("Sheet2").Cells(1, 2).Value = "Commit"
   Sheets("Sheet2").Cells(1, 3).Value = "CKID"
   Sheets("Sheet2").Cells(1, 4).Value = "Status"
   Sheets("Sheet2").Cells(1, 5).Value = "Terminal"
   Sheets("Sheet2").Cells(1, 6).Value = "Address"

   Set rng = ActiveCell
   Dim moveValue As String

   Do While rng.Value <> Empty
       If InStr(rng.Value, " pr") = 0 Then
           MsgBox "Haven't found Pair  "
       Else
           MsgBox rng.Value
       End If
       Set rng = rng.Offset(1)
       rng.Select
   Loop
   MsgBox "Done!"

End Sub

这是数据的一个实例（A列，第1 - 6行）：

 pr 1  stat RCT  commit stat P
  sys:  type 73RMD  no 1  slot: 1  lt:  field stat DZ7K  co stat NREQ
     ckid NONE  lp stat RCT  11-30-13  bp/clr 601  tea 1975 W SOUTHPORT RD
      type FIXED  tec IPLPINPL  fld side capr 1975W:279
     dist tea 7250 WINSLET BLVD  type FIXED  addr: 7250 WINSLET BLVD
       UNIT 2D  serv tea 7250 WINSLET BLVD  type FIXED

代码找到＆＃34; pr＆＃34;的出现，但我似乎无法弄清楚如何拾起并移动它。我需要在表2中格式化的6列重复这一点，但如果我得到第一个的帮助，我可以弄清楚其余部分。

谢谢！

Answer 1

本回答讨论了不推荐的现有代码的功能，并介绍了我认为与您的要求相关的技术。

第1期

Dim i, Lastrow

以上声明i和Lastrow作为可以容纳任何内容的变体。例如，以下代码有效：

i = "A"
i = 5

变量可能非常有用，但它们的访问速度比正确输入的变量要慢。我建议：

Dim i As Long, Lastrow As Long

第2期

Sheets("Sheet2").Range("A1:I500").ClearContents

我认为Range("A1:I500")的意图大于上次运行宏时使用的区域。

我会写Sheets("Sheet2").Cells.ClearContents并让Excel担心上次使用的范围。

请注意ClearContents，顾名思义，仅清除内容。 Clear也会清除任何格式。 Sheets("Sheet2").Cells.EntireRow.Delete将删除内容和格式，并将列宽恢复为默认值。但是，ClearContents可能足以满足您的需求。

第3期

Sheets("Sheet2").Range("A1:I500").ClearContents
Sheets("Sheet2").Cells(1, 1).Value = "Pair"
Sheets("Sheet2").Cells(1, 2).Value = "Commit"
Sheets("Sheet2").Cells(1, 3).Value = "CKID"
Sheets("Sheet2").Cells(1, 4).Value = "Status"
Sheets("Sheet2").Cells(1, 5).Value = "Terminal"
Sheets("Sheet2").Cells(1, 6).Value = "Address"

使用With语句通常会使您的代码更清晰，更快：

With Sheets("Sheet2")
  .Range("A1:I500").ClearContents
  .Cells(1, 1).Value = "Pair"
  .Cells(1, 2).Value = "Commit"
  With .Cells(1, 3)
    .Value = "CKID"
    .Interior.Color = RGB(0, 240, 240)
  End With
  .Cells(1, 4).Value = "Status"
  .Cells(1, 5).Value = "Terminal"
  .Cells(1, 6).Value = "Address"
End With

我有单元格C1表示With语句可以嵌套。

第4期

Set rng = ActiveCell

据我了解，源数据在工作表Sheet1中，从单元格A1开始。以上意味着您的代码将从用户定位光标的任何工作表中的任何单元格开始。如果有一个固定的起点，那么在你的代码中设置它。如果您确实希望用户能够控制起点，请考虑：

If ActiveCell.Worksheet.Name <> "Sheet1" Then
  Call MsgBox("Please position the cursor to the desired starting " & _
              "point in worksheet ""Sheet1""", vbOKOnly)
  Exit Sub
End If

第5期

Set rng = ActiveCell
:
Set rng = rng.Offset(1)
rng.Select

访问选定的单元格比使用VBA寻址访问单元格要慢得多。我还看到程序员在使用Offset时对光标的当前位置感到困惑。您已使用VBA寻址来设置标题行，我已在下面的示例代码中使用它。

第6期

Lastrow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

Do While rng.Value <> Empty

您将Lastrow设置为具有值的最后一行的编号，但是您的循环向下移动到列，直到它到达空单元格。如果数据正文中没有空行，则会得到相同的结果。但是我建议你决定采用哪种方法。

我会避免使用Empty。请参阅What is the difference between =Empty and IsEmpty() in VBA (Excel)?。

示例代码

以下代码包含与您的问题相关的部分。我将包含“pr”的单元格的内容移动到工作表“Sheet2”的第1列，这是您似乎要问的内容。但是，如果您想拆分包含“pr”的单元格并将所选部件复制到Sheet2，我会以不同的方式处理您的要求。如果你澄清你想要的东西，我可以在这个答案中再添加一个部分。

Option Explicit
Sub MovePRRows()

  Dim Rng As Range
  Dim RowSheet1Crnt As Long
  Dim RowSheet1Last As Long
  Dim RowSheet2Crnt As Long
  Dim WSht2 As Worksheet

  Set WSht2 = Worksheets("Sheet2")

  WSht2.Cells.EntireRow.Delete

  RowSheet2Crnt = 2

  With Worksheets("Sheet1")

    RowSheet1Last = .Cells(Rows.Count, "A").End(xlUp).Row

    For RowSheet1Crnt = 1 To RowSheet1Last
      Set Rng = .Cells(RowSheet1Crnt, 1)
      If Rng.Value <> "" Then
        If InStr(1, Rng.Value, " pr") <> 0 Then
        Rng.Copy Destination:=WSht2.Cells(RowSheet2Crnt, 1)
        RowSheet2Crnt = RowSheet2Crnt + 1
        End If
      End If
    Next

  End With


End Sub

将特定数据从列复制到新工作表以进行报告

1 个答案: