VBA宏将单元格以基于单元格内容移动到新的纸张Excel

Question

我环顾四周，找不到我需要的具体响应。所以我会问。 我有一个纸张（表格1），只有在第一个列上的数据。它看起来像这样：

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

是，随着将小区的数据复制到表2中的特定列，它还需要删除数据的第一部分。例如： ID：表格中的R564838需要移动到Sheet2中的ID列，而没有“ID：”。所以只需要移动R564838。 还需要在复制时删除“泰铢：”和“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 

.

结束子

和它起作用。但是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中）

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

.

弄清楚如何将代码放在一起并使它适应确切的需求！

---

回答您的评论：

基本上，是的，但是你可能会陷入一些麻烦，因为它没有完全全面的特定情况。你可能要做的是：

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

例如：

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，然后您可以搜索标题的一列，并复制下一个列值，空白或其他。