2017-10-19 69 views
1

我目前正試圖用質量較短的版本替換單元格中的單詞。我有一個單詞詞典可以縮短,並且會有一列單元格需要縮短一個或多個單詞。在Excel VBA中基於數據庫縮短單詞

我對VBA很新,我不確定我會怎麼做。我試圖搜索,發現一些將改變word文檔中的文本,但沒有任何東西從excel到excel,至少在我的搜索條件。

我已經加入這裏的想法的圖片,能夠縮短文本是在列A中,即可以縮短的詞語是在列C和縮短的版本是在塔D.

Sample

+0

我建議採取看看。查找功能。此頁面有一個示例,其中vba搜索某個值的範圍,然後爲該單元格分配一個新值:https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-find -method-excel – TPhe

回答

0

這裏是一個完整的子版本,如果是工作更好地爲您

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 
+0

這工作完美!甚至還嘗試了第一次嘗試。也感謝您的意見,這將有助於我更好地瞭解正在發生的事情並從中吸取教訓! – ard

+0

樂意幫忙!如果您對答案感到滿意,請考慮'接受'它以幫助具有相同問題的其他人發現它:請參閱[答案被「接受」時的含義是什麼?](https://stackoverflow.com/幫助/接受應答) –

0

您可以使用此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 

將此代碼放入常規模塊中。然後將該公式=SubstituteMultiple(A2,$C$2:$C$11,$D$2:$D$11)寫入單元格B2中,並將其拖動到底部。

enter image description here

0

也許簡單替換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