[英]Shortening words based on database in Excel VBA
我目前正在嘗試用更短的版本替換單元格中的單詞。 我有一個要縮短的單詞字典,並且有一列需要將一個或多個單詞縮短的單元格。
我對VBA非常陌生,我不確定該如何處理。 我嘗試搜索,發現其中一些會更改Word文檔中的文本,但至少從我的搜索字詞來看,從Excel到excel沒有任何改變。
我在此處添加了該創意的圖片,要縮短的文本在A列中,可以縮寫的單詞在C列中,而縮短的版本在D列中。
您可以使用此UDF。
Function SubstituteMultiple(text As String, old_text As Range, new_text As Range)
Dim i As Single
For i = 1 To old_text.Cells.Count
Result = Replace(LCase(text), LCase(old_text.Cells(i)), LCase(new_text.Cells(i)))
text = Result
Next i
SubstituteMultiple = Result
End Function
將此代碼放在常規模塊中。 然后在單元格B2
編寫此公式=SubstituteMultiple(A2,$C$2:$C$11,$D$2:$D$11)
並將其拖到底部。
這是完整的子版本,如果更適合您
Sub ReplaceViaList()
Dim ws As Worksheet
Dim repRng As Range
Dim x As Long, lastRow As Long
Dim repCol As Long, oldCol As Long, newCol As Long
Dim oldStr As String, newStr As String
'screenupdating/calc
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'define worksheet
Set ws = ActiveSheet
'define columns to work with
repCol = 1 'col A
oldCol = 3 'col C
newCol = 4 'col D
'find last row of replacement terms
lastRow = ws.Cells(ws.Rows.Count, repCol).End(xlUp).Row
'set range of items to be replaced
Set repRng = ws.Range( _
ws.Cells(2, repCol), _
ws.Cells(lastRow, repCol) _
)
'loop through cells in replacement terms
For x = 2 To ws.Cells(ws.Rows.Count, oldCol).End(xlUp).Row
'define replacement terms
oldStr = ws.Cells(x, oldCol).Value
newStr = ws.Cells(x, newCol).Value
'replace
repRng.Replace What:=oldStr, Replacement:=newStr
Next x
'screenupdating/calc
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
也許用VBA進行簡單替換就可以做到,
Sub test()
Dim searchval As Variant
Dim replaceval As Variant
searchval = Range("C1:C10")
replaceval = Range("D1:D10")
For i = 1 To 10
Columns("A:A").Replace What:=searchval(i, 1), Replacement:=replaceval(i, 1), LookAt:=xlPart
Next i
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.