gpt4 book ai didi

excel - 如何快速确定字符串的一部分是否与另一个字符串匹配?

转载 作者:行者123 更新时间:2023-12-04 20:18:21 26 4
gpt4 key购买 nike

我的地址列表有时在需要删除的街道后缀末尾有垃圾。例如 Yada Yada St. apt#12 需要成为 Yada Yada St. 现在,我找到了来自 here 的街道后缀及其变体列表。 .我需要在 excel 中完成这一切,所以我将 3 列后缀列表(第 1-3 列分别是主要街道后缀、常用街道后缀或缩写以及邮政服务标准后缀缩写)放入标有 SuffixList 的工作表中,然后我把将地址列表放入表格 1 中,这是代码所在的位置。

我创建了一个代码来检查每个地址与每个后缀变体(SuffixList 上的第 2 列),在我检查的后缀前后使用空格,以确保我没有捕捉到任何街道名称,只是街道后缀。我也有。并且,如下所示,正在检查代码中的变体。我现在使用的代码可以工作,只是时间太长了,我正在寻找一种更快的方法。

此外,每当我找到匹配项时,我都会将使用的街道后缀替换为正式正确的后缀(后缀列表上的第 3 列)。

当前代码:

Sub JunkRemover()
'Link to an official abbreviations list
'https://www.usps.com/send/official-abbreviations.htm

Dim Orig As String
Dim NewAddr As String
Dim x As Integer 'Row Reference
Dim i As Long 'Address List Iterator
Dim y As Integer 'SuffixList Iterator
Dim ChangeCount As Integer
'WARNING!!!!!!!!!!!!
'This code assumes address field is in column A and that the address column has no blanks.
'If that is not the case, replace 1 for the appropriate number for x
'a=1, b=2, c=3, d=4 etc.
x = 1

ChangeCount = 0
i = 2
While Cells(i, x) <> ""
Orig = UCase(Cells(i, x))
y = 2
While Sheets("SuffixList").Cells(y, 2) <> ""

If InStr(1, Orig, " " & UCase(Sheets("SuffixList").Cells(y, 2) & " ")) > 1 Then
NewAddr = Left(Orig, InStr(1, Orig, " " & UCase(Sheets("SuffixList").Cells(y, 3) & " ")) + Len(Sheets("SuffixList").Cells(y, 3)))
Cells(i, x) = NewAddr
ChangeCount = ChangeCount + 1
ElseIf InStr(1, Orig, " " & UCase(Sheets("SuffixList").Cells(y, 2) & ". ")) > 1 Then
NewAddr = Left(Orig, InStr(1, Orig, " " & UCase(Sheets("SuffixList").Cells(y, 3) & ". ")) + Len(Sheets("SuffixList").Cells(y, 3)))
Cells(i, x) = NewAddr
ChangeCount = ChangeCount + 1
ElseIf InStr(1, Orig, " " & UCase(Sheets("SuffixList").Cells(y, 2) & ", ")) > 1 Then
NewAddr = Left(Orig, InStr(1, Orig, " " & UCase(Sheets("SuffixList").Cells(y, 3) & ", ")) + Len(Sheets("SuffixList").Cells(y, 3)))
Cells(i, x) = NewAddr
ChangeCount = ChangeCount + 1
End If
y = y + 1
Wend

i = i + 1
Wend

MsgBox ChangeCount & " Rows Changed", vbOKOnly

End Sub

进一步的例子:
OrigAddress                   NewAddress  
4000 NO MAIN ST 1 4000 NO MAIN ST
135 ALDEN ST APT3 135 ALDEN ST
1820 HIGHLAND AVE 1820 HIGHLAND AVE
4901 NO MAIN ST. REAR 4901 NO MAIN ST
1820 HIGHLAND AVE, 1 1820 HIGHLAND AVE

最终代码用户波特的回答:
Sub JunkRemover2()
'Link to an official abbreviations list
'https://www.usps.com/send/official-abbreviations.htm

Dim Orig As String
Dim NewAddr As String
Dim x As Integer 'Row Reference
Dim i As Long 'Address List Iterator
Dim y As Integer 'SuffixList Iterator
Dim ChangeCount As Integer
Dim PauseTime, Start, Finish, TotalTime As Double
Dim slRows As Double
Dim slCols As Integer
Dim slRowsAddr As Double
Dim slColsAddr As Integer

'WARNING!!!!!!!!!!!!
'This code assumes address field is in column A and that the address column has no blanks.
'If that is not the case, replace 1 for the appropriate number for x
'a=1, b=2, c=3, d=4 etc.
x = 1

ChangeCount = 0

With Sheets("SuffixList")
'i am using Column 1 to find out how many rows there are(change it if you want)
slRows = Sheets("SuffixList").Cells(Rows.Count, 1).End(xlUp).Row
slCols = Sheets("SuffixList").Cells(1, Columns.Count).End(xlToLeft).Column
suffixData = Sheets("SuffixList").Range(Sheets("SuffixList").Cells(2, 2), Sheets("SuffixList").Cells(slRows, slCols))
End With


i = 2
While Cells(i, x) <> ""
Orig = UCase(Cells(i, x))

For y = 1 To slRows - 1


If InStr(1, Orig, " " & UCase(suffixData(y, 1) & " ")) > 1 Then
NewAddr = Left(Orig, InStr(1, Orig, " " & UCase(suffixData(y, 2) & " ")) + Len(suffixData(y, 2)))
Cells(i, x) = NewAddr
ChangeCount = ChangeCount + 1
Exit For
ElseIf InStr(1, Orig, " " & UCase(suffixData(y, 1) & ". ")) > 1 Then
NewAddr = Left(Orig, InStr(1, Orig, " " & UCase(suffixData(y, 2) & ". ")) + Len(suffixData(y, 2)))
Cells(i, x) = NewAddr
ChangeCount = ChangeCount + 1
Exit For
ElseIf InStr(1, Orig, " " & UCase(suffixData(y, 1) & ", ")) > 1 Then
NewAddr = Left(Orig, InStr(1, Orig, " " & UCase(suffixData(y, 2) & ", ")) + Len(suffixData(y, 2)))
Cells(i, x) = NewAddr
ChangeCount = ChangeCount + 1
Exit For
End If
Next

i = i + 1
Wend


MsgBox ChangeCount & " Rows Changed", vbOKOnly

End Sub

最佳答案

你是对的;它很慢,因为每次比较内容时都会访问 Excel 应用程序,这比访问变量要慢得多。

我建议您将想要的相关字段复制到数组中,如下所示:

    dim suffixData as variant

'Now you need to save all that sheets' content into an array
'1stly you need the sheet's dimentions

dim slRows as double
dim slCols as integer
'I am using Column 1 to find out how many rows there are(change it if you want)

with Sheets("SuffixList")
slRows = .Cells(rows.count, 1).end(xlUp).row
slCols = .Cells(1, columns.count).end(xlToLeft).column
suffixData = .Range(.cells(1,1), .cells(slRows, slCols))
end with

从这里开始你应该使用 suffixData(row, column)访问该工作表,就好像它是实际工作表一样。在它的一千多次迭代中,您将看到明显的改进。

您可以对其他工作表执行相同的技巧并计算所有内容,而无需在执行昂贵的循环时查看 Excel。

反过来也是可取的。您不想在每次获得值时都写入单元格。
最好将其写入二维数组,就好像它是电子表格一样,然后将整个数组复制到工作表中。

关于excel - 如何快速确定字符串的一部分是否与另一个字符串匹配?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/15764805/

26 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com