Question

熟悉VBA / Macro，但仍然是新的和挣扎。我已经能够通过在youtube视频上查找示例和玩在线发布的其他代码来拼凑内容，但我遇到困难并需要大量帮助

我的工作簿上有四张纸。所有这些都有相同的布局，第一列是我的标题，并有一个过滤器。隐藏/删除L之后的所有列。

我将信息从应用程序复制/粘贴到第一张工作表（二月 - 监视器），“一个示例在文本到列表上。”我有一个宏将所有内容移动到正确的列上运行第一张。

我想要第一张纸的宏，这样当它运行时，它会执行以下操作;

查看G列中的信息，并将它们移动到下一个空行中的相应工作表中。

待定 - 将任何“DA”或“I”移动到此工作表已接受 - 将任何“AC”移动到此工作表已发布 - 将任何“RL”移动到此工作表中。

有一点需要指出的是，在G列旁边的某些单元格中出现空格，即“T”（T后的两个空格）或“RT”（RT后的一个空格）< / p>

对于其他工作表，我想知道如何修改“Module1”中的代码，以便在键入特定状态后自动将待处理，已接受和已发布工作表的行移动到其他工作表。我玩过代码并且可以让它工作但是它会覆盖第一行而不是将它移动到空行。

2月 - 监控 - 将RT，T，RE，RJ键入的任何内容移至第一张表格待定 - 以DA或我移动到此工作表的任何键入已接受 - 当AC移动到此工作表时，任何键入的内容。发布 - 当RL移动到此工作表时，任何键入的内容。

链接到Google云端硬盘上的电子表格。 https://drive.google.com/open?id=0B6fek87_mXuEMnVCRUtobVVqQU0

非常感谢

Answer 1

答案中有很多if。主要在“set ws”部分。在每个“set”命令的右侧，我将应该发送的字符串放到这些页面上。这些都是正确的吗？如果是这样，当您导入数据时，它是否导入到工作表（“2月 - 监视器”）？这是您在G列中搜索字符串的主页面？如果所有这些都是正确的，那么这应该适合你。制作工作簿的副本并首先在副本中进行尝试。在VBA编辑器中创建一个普通模块并将其粘贴到其中。它将根据G列中找到的字符串复制行，并将其粘贴到相应的页面中。如果要在将这些行复制到其他页面后从工作表（“二月 - 监视器”）中删除这些行，则取消注释（从nextRow = 2中删除'）。

Sub Macro1()
'Feb - Monitor - Anything keyed in as RT, T, RE, RJ
'is moved to the first sheet Pending -
'Anything keyed in as DA or I moves to this sheet Accepted -
'Anything keyed in as AC moves to this sheet. Released -
'Anything keyed in as RL moves to this sheet.

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim lastRow As Long
Dim nextRow As Long
Dim myArray() As Variant


Set ws1 = Worksheets("Feb - Monitor") '  RT, T, RE, RJ
Set ws2 = Worksheets("Pending") '   DA, I
Set ws3 = Worksheets("Accepted") '  AC
Set ws4 = Worksheets("Released") '  RL

lastRow = ws1.Range("G65536").End(xlUp).Row

myArray = ws1.Range("G2:G" & lastRow)


 For i = LBound(myArray) To UBound(myArray)
    If InStr(1, myArray(i, 1), "T") > 0 And InStr(1, myArray(i, 1), "RT") = 0 Or _
        InStr(1, myArray(i, 1), "RT") > 0 Or InStr(1, myArray(i, 1), "RE") > 0 Or _
        InStr(1, myArray(i, 1), "RJ") > 0 Then
        ' These need to stay on Worksheets("Feb - Monitor") so we do nothing
        ' The reason I added this loop is in case I misunderstood your need
        ' This loop is not necessary if we are'nt moving them
    End If
    If InStr(1, myArray(i, 1), "DA") > 0 Or InStr(1, myArray(i, 1), "I") > 0 Then ' send to "Pending"
        nextRow = ws2.Range("G65536").End(xlUp).Row + 1

        ws1.Rows(i + 1).Copy Destination:=ws2.Range("A" & nextRow)
    End If
    If InStr(1, myArray(i, 1), "AC") > 0 Then ' send to "Accepted"
        nextRow = ws3.Range("G65536").End(xlUp).Row + 1
        ws1.Rows(i + 1).Copy Destination:=ws3.Range("A" & nextRow)
    End If
    If InStr(1, myArray(i, 1), "RL") > 0 Then ' send to "Released"
        nextRow = ws4.Range("G65536").End(xlUp).Row + 1
        ws1.Rows(i + 1).Copy Destination:=ws4.Range("A" & nextRow)
    End If

Next i


'*********************************************
'   The following code deletes all rows on worksheets("Feb - Monotor)
'   that are not RT, T, RE, RJ
'   You can uncomment it if you want to do that

'nextRow = 2
'For i = LBound(myArray) To UBound(myArray)
'    nextRow = nextRow + 1
'    If InStr(1, myArray(i, 1), "DA") > 0 Or InStr(1, myArray(i, 1), "I") > 0 _
'        Or InStr(1, myArray(i, 1), "AC") Or InStr(1, myArray(i, 1), "RL") > 0 Then
'        nextRow = nextRow - 1
'        Debug.Print i, myArray(i, 1), nextRow
'        ws1.Rows(nextRow).Delete Shift:=xlUp
'    End If
'Next i

Set ws1 = Nothing
Set ws2 = Nothing
Set ws3 = Nothing
Set ws4 = Nothing


End Sub

VBA /宏自动将行移动到各种其他工作表

1 个答案: