[英]If a cell in range of cells in Excel 2010 contains specific text, move whole cell text into a different column
I am struggling to find an answer to this one...我正在努力寻找这个问题的答案......
Each month I am provided with a spreadsheet full of clients data that is a raw extract from some sort of CRM software and that data is a mess.每个月我都会收到一份包含客户数据的电子表格,这些数据是从某种 CRM 软件中提取的原始数据,而且这些数据一团糟。 Some cells are merged, some are not.有些单元格被合并,有些则没有。 When you unmerge the whole sheet, you end up with data that is meant for one column randomly spread across 3 columns and mixed with another data, ie email addresses are spread across 3 columns and mixed with postcodes.当您取消合并整个工作表时,您最终会得到一列的数据,这些数据随机分布在 3 列中并与另一数据混合,即电子邮件地址分布在 3 列中并与邮政编码混合。
What I'd like to be able to do is search for cells within columns S, T and U that contain "@" and move (not copy) the whole email address to column V on the same row.我希望能够做的是在 S、T 和 U 列中搜索包含“@”的单元格,并将整个电子邮件地址移动(而不是复制)到同一行的 V 列。
How can I achieve that?我怎样才能做到这一点?
You can achieve this with the following formula into V1:您可以在 V1 中使用以下公式来实现此目的:
=INDEX(S1:U1,MATCH(TRUE,NOT(ISERROR(SEARCH("@",S1:U1))),0))
The formula needs to be entered as array formula, ie pressing Ctrl - Shift - Enter .公式需要作为数组公式输入,即按Ctrl - Shift - Enter 。
Press Alt+F11 to open the Visual Basic Editor, and then click Insert, Module.按 Alt+F11 打开 Visual Basic 编辑器,然后单击插入、模块。 Paste this in. Or, just download the example file here .将其粘贴进去。或者,只需在此处下载示例文件。 Then under View/Macros, this movemail() routine will be there.然后在视图/宏下,这个 movemail() 例程将在那里。 Run it.运行。
I take check, money order, paypal, bitcoin... :-) j/j Enjoy.我接受支票,汇票,贝宝,比特币...... :-) j/j 享受。
Sub moveemail()
Dim ws As Worksheet
Dim thisCell As Range, nextCell As Range, lookAt As Range
Dim foundAt As String, lookFor As String
Dim lastRow As Long
lookFor = "@"
On Error GoTo Err
'get last populated cell
Set ws = Application.ActiveSheet
With ws
If WorksheetFunction.CountA(Cells) > 0 Then
lastRow = Cells.Find(what:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
End With
' go cell by cell looking for @ from row 1 to row 10000
Set lookAt = ActiveSheet.Range("S1:U" & lastRow)
Set thisCell = lookAt.Find(what:=lookFor, LookIn:=xlValues, lookAt:=xlPart, SearchDirection:=xlNext)
If Not thisCell Is Nothing Then
Set nextCell = thisCell
Do
Set thisCell = lookAt.FindNext(After:=thisCell)
If Not thisCell Is Nothing Then
foundAt = thisCell.Address
thisCell.Copy Range("V" & thisCell.Row)
thisCell.ClearContents
Else
Exit Do
End If
If thisCell.Address = nextCell.Address Then Exit Do
Loop
Else
'MsgBox SearchString & " not Found"
Exit Sub
End If
Err:
'MsgBox Err.Number
Exit Sub
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.