基于单元格内容的VBA宏将单元格移动到新工作表Excel [英] VBA macro to move cells to a new sheet Excel based on cell content

问题描述

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

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:

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

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.

事实是，随着单元格的数据复制到sheet2中的特定列，它还需要删除数据的第一部分。例如：
ID：需要将sheet1中的R564838移动到sheet2中的ID列，而在其中没有ID：。所以只有R564838需要移动。
当复制时，TITL：和AUTH：将被删除。

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.

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

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

更新

我有这个代码：

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为空，我需要宏留下一个空单元格，以便每本书的信息匹配。
我希望你明白我的问题。

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.

再次感谢！

推荐答案

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

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

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

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

提取所需的内容细胞（去除h eader）

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:"))

将内容放在下一个可用的第二张表（假设ID位于第1列）

Place the content in the next available row of second sheet (assuming ID goes in column 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!

在回答您的评论时：

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

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. 将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

---

这里你去：）

---

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!

这篇关于基于单元格内容的VBA宏将单元格移动到新工作表Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！