| |
19098-123で入力用の略語リストからデータ入力用の
略語を一括置換できないかと相談していたmomoです。
ちゃっぴさんのアドバイスを参考により、マウスで範囲を
指定できるなど初心者に親しみやすく汎用性の高いマクロを作りました。
しかし、置換対象セルが少ないうちはうまく置換してくれるのですが
対象セルが数千個に及ぶと置換してくれません。
私がUBound関数をよく理解できてないからでしょうか？
************************************************
Dim myCell As Range '略語リストの範囲
Dim myMsg As String, myTitle As String
myMsg = "略語リスト（左列に略語、右列に正式名）を選択して下さい。"
myTitle = "略語リストの指定"
On Error Resume Next
Set myCell = Application.InputBox(Prompt:=myMsg, Title:=myTitle, Type:=8)
If myCell Is Nothing Then Exit Sub
Dim myCell2 As Range '置換範囲
Dim myMsg2 As String, myTitle2 As String
myMsg2 = "置換範囲を選択して下さい。"
myTitle2 = "置換範囲の指定"
On Error Resume Next
Set myCell2 = Application.InputBox(Prompt:=myMsg2, Title:=myTitle2, Type:=8)
If myCell2 Is Nothing Then Exit Sub
'Range(myCell2.Address).Select
Dim vntTarget As Variant '置換対象範囲の中のデータ
Dim vntList As Variant '略語リストの中の略語
Dim i As Long, j As Long
'略語リストを配列に格納
vntList = Range(myCell.Address).Value
'置換対象文字列を配列に格納
vntTarget = Range(myCell2.Address).Value
'置換処理
For i = 1 To UBound(vntTarget)
For j = 1 To UBound(vntList)
vntTarget(i, 1) = Replace$(vntTarget(i, 1), _
vntList(j, 1), vntList(j, 2), 1, -1, 0)
Next j
Next i
'置換した配列を一括出力
Range(myCell2.Address).Value = vntTarget
Set rngTarget = Nothing
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
