VBA宏根据单元格内容将单元格移动到新工作表Excel

Question

我环顾四周，无法找到我需要的具体反应。所以我会问。 我有一张表（sheet1），其数据仅在A列上。它看起来像这样：

我需要创建一个VBA宏，在A列中搜索包含ID，TITL和AUTH的任何单元格。 并将它们移动到另一张纸（sheet2）中的特定列。 Sheet2将有3列：ID，Title和Author。

问题是，除了将单元格的数据复制到sheet2中的特定列之外，还需要删除数据的第一部分。例如： ID：sheet1中的R564838需要移动到sheet2中的ID列，而不包含“ID：”。所以只需要移动R564838。 复制时也需要删除“TITL：”和“AUTH：”。

我希望这是有道理的。我只是在学习VBA宏。所以我不知道如何做到这一点。

更新

我有这段代码：

Sub MoveOver() 

Cells(1, 1).Activate 


While Not ActiveCell = "" 

    If UCase(Left(ActiveCell, 4)) = "  ID" Then Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ 
    Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move ID to Col A in sheet 2

    If UCase(Left(ActiveCell, 4)) = "TITL" Then Sheets(2).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ 
    Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move TITL to Col B in sheet 2

    If UCase(Left(ActiveCell, 4)) = "AUTH" Then Sheets(2).Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ 
    Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move AUTH to Col C in sheet 2

    ActiveCell.Offset(1, 0).Activate 

Wend 

End Sub

它有效。但是sheet1中有一些AUTH和TITL是空白的。情况是，当它运行时，只要AUTH或TITL为空，它就不会留下空单元格。 如果AUTH或TITL为空，我需要宏留空单元格，以便每本书的信息匹配。 我希望你理解我的问题。

再次感谢你！

Answer 1

设置一些变量以确保您正在使用正确的工作簿/工作表/列

Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)
col = 1

找到列的最后一个单元格

last1 = ws1.Cells(ws1.Rows.Count, col).End(xlUp).Row

查看每个单元格以确定如何处理它

For x = 1 To last1
    'What you do with each cell goes here
Next x

评估单元格的内容（知道它是否包含特定的内容）

If ws1.Cells(x, col) Like "*ID:*" Then
    'What you do with a cell that has "ID:" in it
End If

提取单元格中感兴趣的内容（删除“标题”）

myID = Mid(ws1.Cells(x, col), InStr(ws1.Cells(x, col), "ID:") + Len("ID:"))

将内容放在第二张表的下一行（假设ID在第1列中）

current2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
ws2.Cells(current2, 1) = myID

弄清楚如何将代码位放在一起并根据您的确切需求进行调整！

---

回答您的评论：

基本上，是的，但是你可能遇到一些麻烦，因为它并不完全全面地解决你的特殊情况。您可能需要做的是：

1. 将ID（一旦找到）存储在变量中;
2. 为标题和作者做同样的事情;
3. 找到分隔线后，您可以将变量的当前内容写入下一个可用行，并清空这些变量的内容。

例如：

If ws1.cells(x, col) Like "*----*" Then
    current2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
    ws2.Cells(current2, 1) = myID
    ws2.Cells(current2, 2) = myTitle
    ws2.Cells(current2, 3) = myAuthor
    myID = ""
    myTitle = ""
    myAuthor = ""
End If

---

你走了:)）

Sub MoveOver() 

Cells(1, 1).Activate 

myId = ""
myTitle = ""
myAuthor = ""

While Not ActiveCell = ""

    If UCase(Left(ActiveCell, 4)) Like "*ID*" Then myId = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

    If UCase(Left(ActiveCell, 4)) = "TITL" Then myTitle = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

    If UCase(Left(ActiveCell, 4)) = "AUTH" Then myAuthor = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

    If ActiveCell Like "*---*" Then
        'NOW, MOVE TO SHEET2!
        toRow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
        Sheets(2).Cells(toRow, 1) = myId
        Sheets(2).Cells(toRow, 2) = myTitle
        Sheets(2).Cells(toRow, 3) = myAuthor
        myId = ""
        myTitle = ""
        myAuthor = ""
    End If

    ActiveCell.Offset(1, 0).Activate

Wend

如果你需要帮助了解我改变了什么，请告诉我，但它应该非常直接！

Answer 2

您可能还想尝试使用：作为分隔符对列进行文本操作。这样可以将您的信息分为2列而不是1，然后您可以在一列中搜索标题并复制下一列值，空白或其他。