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

VBA macro to move cells to a new sheet Excel based on cell content

提问by Alvaro Morales Solis

I look around and could not find the specific response I need. So I will ask. I have a sheet (sheet1) with data only on column A. It looks like this:

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

And I need to create a VBA macro that searches in column A for any cell that contains ID, TITL, and AUTH. And move them to a specific column in another sheet(sheet2). Sheet2 will have 3 columns: ID, Title and Author.

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

The thing is that along with copying the data of the cell to its specific column in sheet2, it also needs to delete the first part of the data. For example: ID: R564838 in sheet1 needs to be moved to the ID column in sheet2, without the "ID:" in it. So only R564838 would need to be moved. Also "TITL:" and "AUTH:" would need to be removed when copied.

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

I hope this makes sense. I am just learning VBA macros. So I have no idea how to accomplish this.

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

UPDATE

更新

I have this code:

我有这个代码：

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

结束子

And it works. But there are some AUTH and TITL in sheet1 that are blank. And the situation is that when this runs, it doesn't leave a empty cell whenever AUTH or TITL are blank. I need the macro to leave an empty cell if AUTH or TITL are blank so the information matches for each book. I hope you understand my issue.

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

Thank you again!

再次感谢你！

回答by Bernard Saucier

Set some variables to make sure you're working on the right workbook/sheet/column

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

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

Find the last cell of the column

查找列的最后一个单元格

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

Look at each cell to figure out what to do with it

查看每个单元格以弄清楚如何处理它

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

Evaluate the content of the cell (Know if it contains something specific)

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

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

Extract the content of interest of the cell (remove the "header")

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

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

Place the content in the next available row of second sheet (assuming ID goes in column 1)

将内容放在第二个工作表的下一个可用行中（假设 ID 在第 1 列中）

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

Figure out how to put the bits of code together and adapt it to your exact needs!

弄清楚如何将代码组合在一起并使其适应您的确切需求！

---

---

In answer to your comment :

回复您的评论：

Basically, yes, but you might bump into some trouble as it's not fully comprehensive of your particular situation. What you might have to do is :

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

1. Store the ID (once you find one) in a variable;
2. Do the same for the title and author;
3. Once you find a delimiting line, you instead write the current content of the variables to the next available line and empty the content of those variables.

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

For example :

例如 ：

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

---

---

Here you go :)

干得好 ：）

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

If you need help understanding what I changed, let me know, but it should be pretty straight forward!

如果您需要帮助了解我更改的内容，请告诉我，但它应该非常简单！

回答by user6922784

You might also want to try doing a text to column with a : as the separator. That would give your information in 2 columns instead of 1, then you could search one column for the header and copy the next column value, blank or otherwise.

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