剪切并将特定字符串值复制到相邻单元格

时间:2015-10-12 13:37:25

标签: excel vba

我在同一个单元格中有一个公司和城市名称的Excel数据库,我想从中将城市名称拆分到找到文本的相邻单元格。我将城市名称作为数组。

数据库看起来像:

FINER SURROUNDINGS EL CAJON
第一个选择管道公司RAMONA
弗兰克吉利兰建筑圣塔YNEZ
等等

到目前为止我的代码(非常简陋):

Sub FindCityNames()  
Dim citylist(500) As String  
Dim i, j, k As Integer  
For j = 1 To 500  
citylist(j) = Workbooks("cities.xlsm").Worksheets("City list").Cells(j, 1)  
Next j  
For i = 1 To 500  
Cells.Find(What:=citylist(i), After:=ActiveCell, LookIn:=xlFormulas, _  
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _  
        MatchCase:=False, SearchFormat:=False).Activate  
    ActiveRange.Cut  
Next i  
End Sub  

哪个应该完成查找字符串并剪切它的工作,但我不知道如何引用它所在的行来选择粘贴区域。

有什么想法吗?

1 个答案:

答案 0 :(得分:1)

最后我设法通过使用字符串来解决问题: 谢谢A.S.H.为了你的帮助!

Sub FindCityNames()
Dim citylist(20000) As String
Dim i, j, k, l As Integer
Dim city, company As String
For j = 1 To 20000
citylist(j) = Workbooks("adatformazas2.xlsm").Worksheets("City list").Cells(j, 1)
Next j

For j = 1 To 20000
city = UCase(citylist(j))
l = Len(city)
If l > 0 Then
 With ActiveSheet
 '.Cells(1, 8) = city
  For i = 1 To .UsedRange.Rows.Count
   company = RTrim(.Cells(i, 1))
   R = Right(company, l)
   If R = city Then
    If .Cells(i, 2).Value = "" Then
    .Cells(i, 1) = RTrim(Left(company, Len(company) - l))
    .Cells(i, 2) = city
   End If
   End If
  Next i
 End With
End If
Next j
End Sub