VBA宏根据单元格内容将单元格移动到新的Excel工作表
我环顾四周,找不到我需要的具体答复。所以我会问。 我有一张表(表1),数据只在a列。它看起来像这样: 我需要创建一个VBA宏,在a列中搜索包含ID、TITL和AUTH的任何单元格。 并将其移动到另一张图纸(图纸2)中的特定列。Sheet2将有3列:ID、标题和作者 问题是,在将单元格的数据复制到sheet2中的特定列的同时,它还需要删除数据的第一部分。例如: 需要将sheet1中的ID:R564838移动到sheet2中的ID列,其中不包含“ID:”。因此,只需移动R564838。 此外,“标题:”和“授权:”在复制时也需要删除 我希望这是有道理的。我只是在学习VBA宏。所以我不知道如何做到这一点 更新 我有以下代码:VBA宏根据单元格内容将单元格移动到新的Excel工作表,vba,excel,Vba,Excel,我环顾四周,找不到我需要的具体答复。所以我会问。 我有一张表(表1),数据只在a列。它看起来像这样: 我需要创建一个VBA宏,在a列中搜索包含ID、TITL和AUTH的任何单元格。 并将其移动到另一张图纸(图纸2)中的特定列。Sheet2将有3列:ID、标题和作者 问题是,在将单元格的数据复制到sheet2中的特定列的同时,它还需要删除数据的第一部分。例如: 需要将sheet1中的ID:R564838移动到sheet2中的ID列,其中不包含“ID:”。因此,只需移动R564838。 此外,“标
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
端接头
它是有效的。但在表1中有一些AUTH和TITL是空白的。情况是,当它运行时,只要AUTH或TITL为空,它就不会留下一个空单元格。
如果AUTH或TITL为空,我需要宏留下一个空单元格,以便信息匹配每本书。
我希望你能理解我的问题
再次感谢你 设置一些变量以确保您使用的工作簿/工作表/列正确
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
评估单元格的内容(知道它是否包含特定内容)
提取单元格的感兴趣内容(删除“标题”)
将内容放在第二张图纸的下一个可用行中(假设ID位于第1列)
找出如何将代码的各个部分组合在一起,并使其适应您的确切需要
回答您的评论: 基本上,是的,但你可能会遇到一些麻烦,因为它不完全全面的具体情况。您可能需要做的是:
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
给你:)
如果你需要帮助了解我改变了什么,让我知道,但这应该是非常直接的 您可能还希望尝试使用:作为分隔符对列执行文本转换。这将在两列而不是一列中显示您的信息,然后您可以在一列中搜索标题并复制下一列的值(空白或其他)。我将在短时间内提供一个关于如何完成此操作的小教程。非常感谢!所以我只需要添加这个:myID=Mid(ws.Cells(x,col),InStr(ws.Cells(x,col),“ID:”)+Len(“ID:”)和这个:current2=ws2.Cells(ws2.Rows.Count,1)。End(xlUp)。Row+1 ws2.Cells(current2,1)=if中的myID?对于ID:,TITL:,和AUTH:?谢谢,但它变得比我能理解的更复杂。对不起,不过你的回答很好。我很感激。我有一些代码,似乎工作,但它给了我一个问题。你能看一下我对这个问题的编辑,让我知道如何处理这个问题吗?非常感谢。伟大的非常感谢。这正是我所需要的。但我只是想了解。在代码中,您在何处保留了空单元格?每次遇到“最后一行”(--),您都会将变量的值存储在各自的单元格中,并将变量的值重置为null,因此,如果在找到下一个“最后一行”之前未找到作者或标题,则变量将返回空字符串!这样,你一次填写一行信息,最后确保所有信息都正确排列。我明白了。你太棒了!谢谢!
myID = Mid(ws1.Cells(x, col), InStr(ws1.Cells(x, col), "ID:") + Len("ID:"))
current2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
ws2.Cells(current2, 1) = myID
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