如果我有大量的工作表充满数据,是否可以使用VBA来取出国家名称?

正如标题所暗示的,我有一个很大的数据集。 B列包含一个数字列表。 在每一行中,都有一些包含文本合并的单元格。 有些是二十个细胞长,在整个随机名称和国名。 我想编写一个脚本来提取每个国家出现的任何国家,并将其粘贴到A列。

到目前为止,伪伪造的脚本是:

Sub PullCountries() Dim Rng As Range Dim i As Long i = 1 Dim LastRow As Long LastRow = Range("B1").End(xlDown).Row While i <= LastRow Set Rng = Range("B" & i) If Application.WorksheetFunction.CountIf(Range(Row(i:i), "United States") Then 'this doesn't work at the moment for triggering when these words appear "United States".Copy 'not sure how to be specific here Rng.Offset(0, -1).paste special ElseIf Application.WorksheetFunction.CountIf(Range(Row(i:i), "Canada") Then "Canada".Copy Rng.Offset(0, -1).paste special 'My plan was to write a line for the countries that appear most common, then carry out the rest manually. Else: i + i = 1 End If Wend End Sub 

显然,行“美国”。复制不起作用,和(行(我:我))提出了一个错误。

有没有人有任何想法如何使这项工作?

我的build议是使用FindAll方法。 这给出了一个概述。

 Dim SearchRange As Range, FindWhat As Variant, FoundCells As Range, FoundCell As Range FindWhat = Array("Country1","Country2","Country3",etc) Set SearchRange = ActiveSheet.Range("B:B") For s = LBound(FindWhat) to UBound(FindWhat) Set FoundCells = FindAll(SearchRange:=SearchRange, FindWhat:=FindWhat(s), LookIn:=xlValues,LookAt:=xlWhole, MatchCase:=False) If Not FoundCells Is Nothing Then For each FoundCell In FoundCells FoundCell.Offset(,-1).Value = FoundCell.Value Next End If Next s 

我上面写的代码将循环遍历B列,查找您在数组FindWhat中提供的每个值/国家/地区名称。 对于find的国家/地区的每个实例,都会将该国粘贴到同一行的columnA中。 让我知道,如果你想粘贴在列A的第一个开放/顶部,而不是在同一行中find每个值,我会相应地调整代码。 我不清楚你想要的两个中的哪一个。 我希望这有帮助。