[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『置換をマクロで処理したいです』（nya）
マクロ初心者ですが宜しくお願い致します。
エクセルのシートの
A列に置換前の数字や文字列、
B列に置換後の数字や文字列
を用意して一番上から最後まで順番に
処理を行って、C列に成功したか失敗したかを
残していくマクロはどのようにすれば宜しいでしょうか？
置換をしたいのは別のエクセルファイルを選択する仕様をイメージしております。
また、画像ファイルのファイル名も上記の用な流れでファイル名を置換することは可能でしょうか？
恐れ入りますが、ご回答宜しくお願い致します。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
何をしたいのかが伝わらないので、うまくいかないまでも、ご自分で書いたコードがあれば、それを貼ってください。
（???） 2018/07/03(火) 12:52
エクセルも画像ファイルも置換前と置換後の文字列または数字は
シート1のA列とB列に用意しておくという意味です。
TESTというエクセルファイルのシート1の
A列に一行目から置換前の文字や数値を貼り付けて、
B列の一行目からは置換後の文字や数値を貼り付けて
C列に成功と失敗の結果を残すとどれが置換されたか確認できますので可能であれば
お願い致します。
置換前と置換後を用意したエクセルファイルからまずどのファイルを置換していくか
ファイル選択でフォルダを開かせて、ファイル選択⇒置換しますか？はい、いいえ⇒
はいで置換スタートみたいなイメージです。
（nya） 2018/07/03(火) 15:25
あと、CountIF関数とかで事前に数えるのはなしですか？
置換機能で置き換えるものがなくてもエラーとか返さないし、
置き換えるものがなければ、置き換えなかったのと同じだし、
失敗というイメージが掴みにくいかなと。
（まっつわん） 2018/07/03(火) 15:52
ご返答ありがとうございます。
失敗に関しましては置き換える文字が見つからなかったという意味です。
何千個と置換する文字がある場合、どれが見つからなかったのかあとで調べれたらと思い
記載しました。
置換したいリストに漏れがある可能性があるためです。
ややこしい場合はこちらは後回しでとりあえず
置換ができれば大丈夫です。
宜しくお願い致します。
（nya） 2018/07/03(火) 17:12
>C列に成功したか失敗したかを >残していくマクロはどのようにすれば宜しいでしょうか？
1）C列にCountIf関数で数えて0より大きなら成功、それ以外なら失敗という数式を入れる。
2）C列の個々のセルを順に見て行って、もし、成功なら、置換を実行する。
とすればよいと思います。
ファイル名の場合は全く違った話になるので、
別途考えた方が良いと思います。
とはいえ画像ファイルに限定した話なら、
自作するより、フリーのソフトを使ってはいかがでしょうか？
http://www.ryouto.jp/f6exif/
ファイルのリネーム機能のほかにも便利そうな機能があります。
（まっつわん） 2018/07/04(水) 09:20
置換したいのは、ブックの中の全シートの全文字列が対象なのですか？ それとも、フォルダ指定した中にある各ファイル名なのですか？ それが判らないと、文字列置換にはReplace命令を使ってください、としか書きようがないです。
（???） 2018/07/04(水) 10:21
画像ファイルの置換は当方でもフリーソフトで見つけましてできました！
エクセルファイルについてですが、
置換のマクロは記録をしてコードを作って編集すると、
Cells.Replace What:="置換前1", Replacement:="置換後1", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="置換前2 ", Replacement:="置換後2", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="置換前3 ", Replacement:="置換後3", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
このようにコードをコピペすれば作れますが置換の文字が多い場合が大変ですので、
置換のマクロの対象をエクセルのa列とb列に用意してはどうかと思いご相談させて頂きました。
◆
置換前 置換後 処理結果
1 a
2 AB
3 B
4 C
5 J 見つかりませんでした
6 N
7 S
8 SA 見つかりませんでした
9 A
10 AB
11 B
12 C
13 J
14 N
15 S 見つかりませんでした
16 SA
17 A
18 AB
19 B
20 C
こちらを上から順にエクセルの表を使ってマクロで置換をするという流れです。
置換したいファイルはファイル選択をするという流れをイメージしております。
いかがでしょうか？
（nya） 2018/07/04(水) 18:17
ここが、
左側に（行の先頭に）空白があると崩れない仕様なようなので、
敢えて表の左側に空白列を一つ挿入し、
その空白列も含めてコピペしてみてください。
あと、送信前にプレビューも確認してみてください。
つまり、シート上にどのように値が羅列してあるかで、
その値のあるセルをどのように取得していくのかの考え方が変わるので、
想像力を働かせて無駄に考えたり、無駄に作業をしたくないということです。
◆ 置換前 置換後 処理結果 1 a 2 AB 3 B 4 C 5 J 見つかりませんでした 6 N 7 S 8 SA 見つかりませんでした 9 A 10 AB 11 B 12 C 13 J 14 N 15 S 見つかりませんでした 16 SA 17 A 18 AB 19 B 20 C
そのままこちらにコピペするとこうなるのですが、
番号を文字に置き換えるわけではないですよね？
（まっつわん） 2018/07/05(木) 08:37
置換前の文字や数値を
A列に、置換後をB列に貼り付けるというシンプルな表なのですが。
置換する文字や数値をマクロの中に書き込むのではなくセルA(1,1)から一番下まで順に
置換していくいうプログラムをイメージしております
（nya） 2018/07/05(木) 15:59
Sub sample()
Dim Name_Before As Variant
Dim Name_After As Variant
Dim Row As Integer
Dim Path As String
Dim File As String
File = ThisWorkbook.Name
Path = ThisWorkbook.Path
Row = 1
Name_Before = Dir(Path & "\*")
Do While Name_Before <> ""
If Name_Before <> "." And Name_Before <> ".." And Name_Before <> File Then
Name_After = Cells(Row, 2)
Debug.Print Name_Before
Debug.Print Name_After
Name Path & "\" & Name_Before As Path & "\" & Name_After
Row = Row + 1
End If
Name_Before = Dir
Loop
End Sub
※A列に記載する名前は、実際に変換するファイルの名前の
順番と一致していないといけないです
（ゆ） 2018/08/08(水) 12:16
Sub main()
Dim fn As String, afn As String, c As Range, wb As Workbook, sht As Worksheet
MsgBox "置換前のエクセルファイルを選択してください"
fn = Application.GetOpenFilename(FileFilter:="Excel ファイル (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm", FilterIndex:=1, Title:="置換前のエクセルファイルを選択", MultiSelect:=False)
If fn <> "False" Then
afn = Left(fn, InStrRev(fn, "\")) & "置換後" & Mid(fn, InStrRev(fn, "\") + 1)
FileCopy fn, afn
Else
Exit Sub
End If
Set wb = Workbooks.Open(afn)
For Each c In ThisWorkbook.Sheets("Sheet1").Range("A:A").SpecialCells(2)
c.Offset(, 2).Value = "見つかりませんでした"
For Each sht In wb.Worksheets
If Not sht.Cells.Find(c.Value, , , LookAt:=xlPart) Is Nothing Then c.Offset(, 2).Value = ""
sht.Cells.Replace What:=c.Value, Replacement:=c.Offset(, 1).Value, LookAt:=xlPart
Next sht
Next c
Application.DisplayAlerts = False
wb.Close True
End Sub
（mm） 2018/08/08(水) 14:12
こんな感じで
Sub test()
Dim fn As String, rng As Range, r As Range, c As Range
fn = Application.GetOpenFilename("ExcelBooks,*.xls*")
If fn = "False" Then Exit Sub
Application.ScreenUpdating = False
Set rng = ThisWorkbook.Sheets("sheet1").Cells(1).CurrentRegion.Offset(1)
rng.Columns(3).ClearContents
With Workbooks.Open(fn).Sheets(1)
For Each r In rng.Columns(1).Cells
If r.Value <> "" Then
Set c = .Cells.Find(r.Value, , , 2)
If c Is Nothing Then
r(, 3) = "見つかりませんでした"
Else
.Cells.Replace r.Value, r(, 2).Value, 2
End If
End If
Next
.Parent.Close True
End With
Application.ScreenUpdating = True
End Sub
（seiya） 2018/08/08(水) 15:37
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.