VBA宏将单元格以基于单元格内容移动到新的纸张Excel
题
我环顾四周,找不到我需要的具体响应。所以我会问。 我有一个纸张(表格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为空白,我需要宏留下空的小区,因此每本书的信息匹配。 我希望你理解我的问题。
再次谢谢!
解决方案
设置一些变量以确保您正在进行正确的工作簿/表格/列
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(一旦找到一个);
- 对标题和作者做同样的事情;
- 一旦找到划定行,就会将变量的当前内容写入下一个可用行,并清空这些变量的内容。
例如:
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
.
如果您需要帮助理解我的改变,请告诉我,但它应该非常直向前!
其他提示
您可能还想尝试使用A:作为分隔符进行列的文本。这将在2列中提供您的信息而不是1,然后您可以搜索标题的一列,并复制下一个列值,空白或其他。
不隶属于 StackOverflow