在Excel VBA中缩短基于数据库的单词

Question

我目前正在尝试用质量较短的版本替换单元格中的单词。我有一个单词词典可以缩短，并且会有一列需要缩短一个或多个单词的单元格。

我对VBA很新，我不确定如何解决这个问题。我尝试搜索并找到了一些可以改变单词doc中的文本但是从Excel到excel都没有，至少在我的搜索条件下。

我在这里添加了一张Idea的图片，要缩短的文字在A栏中，可以缩短的文字在C栏中，缩短的版本在D栏。

Sample

Answer 1

您可以使用此UDF。

// convert to java.util.Date
Date date = DateTimeUtils.toDate(instant);

// or from the OffsetDateTime
Date date = DateTimeUtils.toDate(odt.toInstant());

将此代码放在常规模块中。然后在单元格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)并将其拖到底部。

Answer 2

如果这对您更有效，那么这是一个完整的子版本

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

Answer 3

或许在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