VBAmacros将单元格移动到基于单元格内容的新工作表Excel中

我环顾四周，找不到我需要的具体回应。 所以我会问。 我有一个工作表（sheet1），只有列A上的数据。它看起来像这样：

我需要创build一个VBAmacros，在列A中search任何包含ID，TITL和AUTH的单元格。 并将它们移动到另一个工作表中的特定列（工作表2）。 Sheet2将有3列：ID，标题和作者。

事情是，在将单元格的数据复制到sheet2中的特定列的同时，还需要删除第一部分数据。 例如：工作表1中的ID：R564838需要被移动到工作表2中的ID列，而不包含其中的“ID：”。 所以只有R564838需要移动。 此外，“TITL：”和“AUTH：”在复制时需要删除。

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

UPDATE

我有这个代码：

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 

结束小组

它工作。 但是sheet1中有一些AUTH和TITL是空白的。 而且情况是，当这个运行的时候，只要AUTH或者TITL都是空的，它就不会留下一个空单元。 如果AUTH或TITL是空的，我需要macros留下一个空单元格，以便每本书的信息都匹配。 我希望你能理解我的问题。

再次感谢你！

Answer 1

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

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

find列的最后一个单元格

 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（一旦find）存储在一个variables中;
2. 为标题和作者做同样的事情;
3. 一旦find一个分隔线，你就把variables的当前内容写到下一个可用的行，并清空这些variables的内容。

例如 ：

 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

您可能还想尝试做一个文本列：a作为分隔符。 这将给你的信息在2列而不是1，那么你可以search一个列的标题，并复制下一列值，空白或以其他方式。