求助：如何使用函数批量替换单元格内的字符串？

limonet

关键字：list.positionof

翁知江安

Sub 批量替换()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim i, j, k, m, s, t, p
Dim ar, br, cr, dr As Variant
ar = Sheet1.[f1].CurrentRegion
For i = 2 To UBound(ar)
    d(ar(i, 1)) = ar(i, 2)
Next
br = Sheet1.[a1].CurrentRegion
ReDim cr(1 To UBound(br) - 1, 1 To 100)
ReDim dr(1 To UBound(br) - 1, 1 To 1)
  For j = 2 To UBound(br)
  m = m + 1
  s = WorksheetFunction.Substitute(br(j, 1), "-", "")
  t = Len(br(j, 1)) - Len(s) + 1
  If t = 1 Then
   cr(m, 1) = br(j, 1)
   dr(m, 1) = d(cr(m, 1))
   Else
    For p = 1 To t
    cr(m, p) = Split(br(j, 1), "-")(p - 1)
     If p = 1 Then
      dr(m, 1) = d(cr(m, p))
      Else
      dr(m, 1) = dr(m, 1) & "-" & d(cr(m, p))
     End If
    Next
    End If
Next
Sheet1.[b2].Resize(UBound(dr), 1).ClearContents
Sheet1.[b2].Resize(UBound(dr), 1) = dr
MsgBox "ok"
End Sub

翁知江安

供参考，欢迎批评指正