[英]VBA macro to move cells to a new sheet Excel based on cell content
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: 我有一个工作表(sheet1),其数据仅在列A上。它看起来像这样:
And I need to create a VBA macro that searches in column A for any cell that contains ID, TITL, and AUTH. 我需要创建一个VBA宏,该宏在A列中搜索包含ID,TITL和AUTH的任何单元格。 And move them to a specific column in another sheet(sheet2). 并将它们移动到另一个工作表(sheet2)中的特定列。 Sheet2 will have 3 columns: ID, Title and Author. 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. 事实是,将单元格数据复制到sheet2中的特定列的同时,还需要删除数据的第一部分。 For example: ID: R564838 in sheet1 needs to be moved to the ID column in sheet2, without the "ID:" in it. 例如:工作表1中的ID:R564838需要移到工作表2中的ID列,而其中没有“ ID:”。 So only R564838 would need to be moved. 因此只需要移动R564838。 Also "TITL:" and "AUTH:" would need to be removed when copied. 复制时,也需要删除“ TITL:”和“ AUTH:”。
I hope this makes sense. 我希望这是有道理的。 I am just learning VBA macros. 我只是在学习VBA宏。 So I have no idea how to accomplish this. 所以我不知道如何实现这一目标。
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. 但是sheet1中有一些AUTH和TITL是空白的。 And the situation is that when this runs, it doesn't leave a empty cell whenever AUTH or TITL are blank. 情况是,当它运行时,只要AUTH或TITL为空,它就不会留下一个空单元格。 I need the macro to leave an empty cell if AUTH or TITL are blank so the information matches for each book. 如果AUTH或TITL为空白,则我需要宏将其留空单元格,以便每本书的信息都匹配。 I hope you understand my issue. 希望您理解我的问题。
Thank you again! 再次感谢你!
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 : 您可能需要做的是:
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! 如果您需要帮助以了解我的更改,请告诉我,但这应该很简单!
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列,然后您可以在一列中搜索标题,然后复制下一个列的值(空白或其他)。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.