Results of 1 - 1 of about 37697 for IF (0.007 sec.)
- [[20081219111246]]
- #score: 1591
- @digest: 61ecade42c34040d62306b3db62c8d64
- @id: 41397
- @mdate: 2008-12-24T05:49:40Z
- @size: 25880
- @type: text/plain
- #keywords: actvdata (233673), swch (81536), txtbox (77741), vbuppercase (53966), cmb1 (45021), 値", (28221), strconv (27237), 行", (21775), vbwide (21331), data (16288), withevents (11983), check (11316), forms (10745), msforms (9719), controls (9573), matchbyte (9370), iif (9250), commandbutton (7343), vbexclamation (7211), checkbox (6797), caption (6081), replace (5795), xlformulas (5775), xlcelltypeformulas (5547), ト. (5340), height (5242), xlwhole (4815), matchcase (4382), replacement (4259), width (4253), lookat (4158), xlpart (4120)
- 『置換え』（sinmaipapa）
いつも参考にさせていただいております。 置換えですが、うまくいきません。 設定条件式 Cells.Replace What:="A", Replacement:="C" Cells.Replace What:="B", Replacement:="E" Cells.Replace What:="C", Replacement:="K" ・・・20個以上続きます。 元データ A B C 変更したい形 C E K 現状 K E K おそらくA→Cと置き換えられたものが、またCの条件式に反応してA→C→Kとなってしまっていると思われます。 また、置換えられる値は規則的ではありません。 説明不足があれば指摘してください。 よろしくおねがいします。 ---- お書きのとおりですので、置き換えの順序を変えることで可能なのかもしれません。 C→KをA→Cの前に置換する。 でも、20個以上あるとなると、それらをみないことにはどうにもならないような気もしますし、 書いてあるのはダミーの条件だったりすると、回答が無駄になるような気もしますが。。。 (Hatch) ---- 早速ありがとうございます。 確かにダミーですが、ほとんどそのままです。 順番を入れ替えることで、対応できるところもあるのですが対応しきれないところがあり、 例えば、検索文字列をA&B&Cや、AorBorCみたいな表示をして、1つの条件式にして出来ないかな?と思っています。 なんとなくですが、そうすれば2回検索しないので1回で置換えが済めばこのようなことがおきないのでは?と思っています。 質問の意味が分かりづらいでしょうか? (sinmaipapa) ---- 置換がセルの内容と完全に一致するものを置き換える場合(LookAt:=xlWhole)であれば「A→!C」「B→!E」「C→!K」に置き換え後、 セルの一部分でも合致したら置き換える置換(LookAt:=xlPart)で「!」を「""」（空文字）に置き換えるといった方法もあるかと。 (独覚) ---- ＞ほとんどそのままです。 の「ほとんど」がくせ者ですよね。 アルファベット一文字で有れば 順番を入れ替えて、最初と最後に成る文字は （と言ってもループするので、どこかの一文字ですが） 最初に違う文字に置き換えておけば良い様に思います。 例えば、A→C,C→K,K→Aの様にループするなら まずKを「★」に変えておいてA→C,C→Kにしたあと ★→Aをする。 (HANA) ---- かような方法はあります。 ユーザーフォームを一つ作ります。そのフォームは一切さわらなくてもいいです。 標準モジュールに Sub 検索() UserForm1.Show End Sub をコピペ 後フォームモジュールに下のコードを貼り付けます。 検索を実行し、検索文字を _ で区切ります。A_B_C といった塩梅に。 置き換えをクリックし、今度は置き換え文字を書き込みます。これも _ で区切って 書き込みます。 後は必要項目をクリックすれば置き換わります。 （弥太郎） '------------------------- Option Explicit Private flg As Boolean Private txt As Boolean Private Lbl As MSForms.Label Private c_1 As Boolean, c_2 As Boolean, c_3 As Boolean Private WithEvents 全て置き換え As MSForms.CommandButton Private WithEvents txtbox As MSForms.TextBox Private WithEvents cmb1 As MSForms.ComboBox Private WithEvents テキスト As MSForms.TextBox Private WithEvents check_1 As MSForms.CheckBox Private WithEvents check_2 As MSForms.CheckBox Private WithEvents check_3 As MSForms.CheckBox Private WithEvents cmb As MSForms.ComboBox Private WithEvents 検索 As MSForms.CommandButton Private WithEvents 閉じる As MSForms.CommandButton Private WithEvents 置き換え As MSForms.CommandButton Private Sub check_1_Click() c_1 = IIf(check_1, 1, 0) txt = True End Sub Private Sub check_2_Click() c_2 = IIf(check_2, 1, 0) txt = True End Sub Private Sub check_3_Click() c_3 = IIf(check_3, 1, 0) txt = True End Sub Private Sub cmb_Click() txt = True End Sub Private Sub cmb1_Click() txt = True End Sub Private Sub txtbox_Change() flg = True End Sub Private Sub テキスト_Change() txt = True End Sub Private Sub 検索_Click() Dim txt1 As String, c As Range, txt2 As String, rng As Range, data, x Dim u As Integer, i As Integer, fnd_type, y(), tbl Application.ScreenUpdating = False txt1 = Replace(テキスト.Text, "_", "_") txt2 = cmb.Value data = Split(txt1, "_", -1) Static flag As Boolean Static b As Integer Static m() As Variant If txt Then flag = False: txt = False With CreateObject("vbscript.regexp") .Pattern = "(¥D+)(¥d+)" If UBound(data) <> 0 And Not flag Then fnd_type = IIf(cmb1 = "値", xlCellTypeConstants, xlCellTypeFormulas) Cells.SpecialCells(fnd_type).Cells(1, 1).Activate ReDim x(1 To Rows.Count, 1 To 2) For i = 0 To UBound(data) For Each rng In Cells.SpecialCells(fnd_type) On Error Resume Next Set c = rng.Find(What:=data(i), LookIn:=IIf(cmb1 = "値", xlValues, xlFormulas), _ LookAt:=IIf(c_3, xlWhole, xlPart), MatchCase:=IIf(c_1, True, False), _ MatchByte:=IIf(c_2, True, False)) If Not c Is Nothing Then ReDim Preserve y(u) If IsError(Application.Match(c.Address(0, 0), y, 0)) Then y(u) = c.Address(0, 0) u = u + 1 x(u, 1) = .Replace(c.Address(0, 0), "$1") x(u, 2) = .Replace(c.Address(0, 0), "$2") End If End If Next rng Next i If u = 0 Then MsgBox "そのデータはみあたりまへん", vbExclamation: Exit Sub Sheets.Add.Name = "dmy" With Sheets("dmy") .Range("a1").Resize(u, 2) = x .Range("a1").Resize(u, 2).Sort _ key1:=IIf(txt2 = "行", .Range("b1"), .Range("a1")), Order1:=xlAscending, key2:= _ IIf(txt2 = "行", .Range("a1"), .Range("b1")), Order2:=xlAscending tbl = .Range("a1").Resize(u, 2) Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True End With For i = 1 To u ReDim Preserve m(i - 1) m(i - 1) = tbl(i, 1) & tbl(i, 2) Next flag = True b = 0 Range(m(b)).Activate ElseIf flag Then b = b + 1 If UBound(m) + 1 = b Then b = 0 On Error Resume Next Range(m(b)).Activate If IsError(Range(m(b)).Activate) Then MsgBox "予期せぬエラーが発生しました。もう一度やり直してくらはい。", vbExclamation Unload Me Exit Sub End If Else On Error Resume Next If cmb1 = "数式" Then ReDim x(1 To Rows.Count, 1 To 2) For Each rng In Cells.SpecialCells(xlCellTypeFormulas) On Error Resume Next Set c = rng.Find(What:=テキスト.Text, LookIn:=xlFormulas, _ LookAt:=IIf(c_3, xlWhole, xlPart), MatchCase:=IIf(c_1, True, False), _ MatchByte:=IIf(c_2, True, False)) If Not c Is Nothing Then ReDim Preserve y(u) If IsError(Application.Match(c.Address(0, 0), y, 0)) Then y(u) = c.Address(0, 0) u = u + 1 x(u, 1) = .Replace(c.Address(0, 0), "$1") x(u, 2) = .Replace(c.Address(0, 0), "$2") End If End If Next rng If u = 0 Then MsgBox "そのデータはみあたりまへん", vbExclamation: Exit Sub Sheets.Add.Name = "dmy" With Sheets("dmy") .Range("a1").Resize(u, 2) = x .Range("a1").Resize(u, 2).Sort _ key1:=IIf(txt2 = "行", .Range("b1"), .Range("a1")), Order1:=xlAscending, key2:= _ IIf(txt2 = "行", .Range("a1"), .Range("b1")), Order2:=xlAscending tbl = .Range("a1").Resize(u, 2) Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True End With For i = 1 To u ReDim Preserve m(i - 1) m(i - 1) = tbl(i, 1) & tbl(i, 2) Next flag = True b = 0 Range(m(b)).Activate Else Cells.Find(What:=txt1, After:=ActiveCell, LookIn:=IIf(cmb1 = "値", xlValues, _ xlFormulas), LookAt:=IIf(c_3, xlWhole, xlPart), SearchOrder:=IIf(txt2 = _ "行", xlByRows, xlByColumns), SearchDirection:=xlNext, MatchCase:= _ IIf(c_1, True, False), MatchByte:=IIf(c_2, True, False)).Activate End If End If If Err.Number = 91 Then MsgBox "それはありまへ〜ん", vbExclamation Err.Clear End If End With Application.ScreenUpdating = True On Error GoTo 0 End Sub Private Sub 全て置き換え_Click() Dim txt_data As String, i As Integer, u As Integer, rng As Range, data_1 Dim c As Range, actvdata As String, data As String, n As Integer, swch_data, f_data Dim data_2 txt_data = Replace(テキスト.Text, "_", "_") If Not txt_data Like "*_*" Then On Error Resume Next Cells.Replace What:=テキスト.Text, Replacement:=txtbox.Text, LookAt:= _ IIf(c_3, xlWhole, xlPart), SearchOrder:=IIf(cmb = "行", xlByRows, xlByColumns), _ MatchCase:=IIf(c_1, True, False), MatchByte:=IIf(c_2, True, False) If Err.Number = 1004 Then MsgBox "入力された式は成立しません!", vbExclamation Err.Clear On Error GoTo 0 Exit Sub End If Else With CreateObject("vbscript.regexp") If Replace(txtbox.Text, "_", "_") Like "*_*" Then data_1 = Split(txt_data, "_", -1) data_2 = Split(Replace(txtbox.Text, "_", "_"), "_", -1) If UBound(data_1) <> UBound(data_2) Then MsgBox "置き換えの数がちゃいます!", vbExclamation txtbox.Text = "" txtbox.SetFocus Else For Each rng In Cells.SpecialCells(IIf(cmb1 = "値", xlCellTypeConstants, xlCellTypeFormulas)) swch_data = IIf(cmb1 = "値", rng.Value, rng.Formula) For i = 0 To UBound(data_1) Set c = rng.Find(What:=data_1(i), LookIn:=IIf(cmb1 = "値", xlValues, xlFormulas), _ LookAt:=IIf(c_3, xlWhole, xlPart), MatchCase:=IIf(c_1, True, False), _ MatchByte:=IIf(c_2, True, False)) If Not c Is Nothing Then If swch_data Like "=*" Then data = StrConv(StrConv(data_1(i), vbNarrow), vbUpperCase) actvdata = swch_data Else If c_1 + c_2 + c_3 = 0 Then data = StrConv(StrConv(data_1(i), vbWide), vbUpperCase) actvdata = StrConv(StrConv(swch_data, vbWide), vbUpperCase) End If If c_1 Then data = StrConv(data_1(i), vbWide) actvdata = StrConv(swch_data, vbWide) End If If c_2 Then data = StrConv(data_1(i), vbUpperCase) actvdata = StrConv(swch_data, vbUpperCase) End If If c_1 And c_2 Then data = data_1(i) actvdata = swch_data End If If c_3 Then If c_1 + c_2 = 0 Then data = StrConv(StrConv(data_1(i), vbWide), vbUpperCase) actvdata = StrConv(StrConv(swch_data, vbWide), vbUpperCase) End If End If End If .Pattern = data .Global = True If .test(actvdata) Then n = WorksheetFunction.Find(data, actvdata, 1) For u = 1 To .Execute(actvdata).Count On Error Resume Next f_data = IIf(cmb1 = "値", rng.Value, rng.Formula) rng = WorksheetFunction.Replace(f_data, WorksheetFunction _ .Find(data, actvdata, n), Len(data), data_2(i)) If swch_data Like "=*" Then actvdata = rng.Formula Else actvdata = IIf(c_1 + c_2 + c_3 = 0, StrConv(StrConv(rng, vbWide), _ vbUpperCase), IIf(c_1 And c_2, rng, IIf(c_1, StrConv(rng, _ vbWide), IIf(c_2, StrConv(rng, vbUpperCase), rng)))) End If n = WorksheetFunction.Find(data, actvdata, 1 + Len(data_2(i)) - _ Len(data) + 1) + Len(data_2(i)) - Len(data) Next u End If End If Next i Next rng End If Else For Each rng In Cells.SpecialCells(IIf(cmb1 = "値", xlCellTypeConstants, xlCellTypeFormulas)) For i = 0 To UBound(data_1) Set c = rng.Find(What:=data_1(i), LookIn:=IIf(cmb1 = "値", xlValues, xlFormulas), _ LookAt:=IIf(c_3, xlWhole, xlPart), MatchCase:=IIf(c_1, True, False), _ MatchByte:=IIf(c_2, True, False)) If Not c Is Nothing Then If swch_data Like "=*" Then data = StrConv(StrConv(data_1(i), vbNarrow), vbUpperCase) actvdata = swch_data Else If c_1 + c_2 + c_3 = 0 Then data = StrConv(StrConv(data_1(i), vbWide), vbUpperCase) actvdata = StrConv(StrConv(swch_data, vbWide), vbUpperCase) End If If c_1 Then data = StrConv(data_1(i), vbWide) actvdata = StrConv(swch_data, vbWide) End If If c_2 Then data = StrConv(data_1(i), vbUpperCase) actvdata = StrConv(swch_data, vbUpperCase) End If If c_1 And c_2 Then data = data_1(i) actvdata = swch_data End If If c_3 Then If c_1 + c_2 = 0 Then data = StrConv(StrConv(data_1(i), vbWide), vbUpperCase) actvdata = StrConv(StrConv(swch_data, vbWide), vbUpperCase) End If End If End If .Pattern = data .Global = True If .test(actvdata) Then n = WorksheetFunction.Find(data, actvdata, 1) For u = 1 To .Execute(actvdata).Count On Error Resume Next f_data = IIf(cmb1 = "値", rng.Value, rng.Formula) rng = WorksheetFunction.Replace(f_data, WorksheetFunction _ .Find(data, actvdata, n), Len(data), txtbox.Text) If swch_data Like "=*" Then actvdata = rng.Formula Else actvdata = IIf(c_1 + c_2 + c_3 = 0, StrConv(StrConv(rng, vbWide), _ vbUpperCase), IIf(c_1 And c_2, rng, IIf(c_1, StrConv(rng, _ vbWide), IIf(c_2, StrConv(rng, vbUpperCase), rng)))) End If n = WorksheetFunction.Find(data, actvdata, 1 + Len(txtbox.Text) - _ Len(data) + 1) + Len(txtbox.Text) - Len(data) Next u End If End If Next i Next rng End If End With End If txt = True End Sub Private Sub 置き換え_Click() Dim i As Integer, txt_data As String, actvdata As String, data_1, data_2 Dim data As String, n As Integer, u As Integer, swch_data txt_data = Replace(テキスト.Text, "_", "_") If flg Then If txt_data Like "*_*" Then With CreateObject("vbscript.regexp") swch_data = IIf(cmb1 = "値", ActiveCell.Value, ActiveCell.Formula) actvdata = StrConv(StrConv(swch_data, vbWide), vbUpperCase) data_1 = Split(txt_data, "_", -1) If Replace(txtbox.Text, "_", "_") Like "*_*" Then data_2 = Split(Replace(txtbox.Text, "_", "_"), "_", -1) If UBound(data_1) <> UBound(data_2) Then MsgBox "置き換えの数がちゃいます!", vbExclamation txtbox.Text = "" txtbox.SetFocus Else For i = 0 To UBound(data_1) data = StrConv(StrConv(data_1(i), vbWide), vbUpperCase) .Pattern = data .Global = True If .test(actvdata) Then n = 1 For u = 1 To .Execute(actvdata).Count On Error Resume Next ActiveCell = WorksheetFunction.Replace(swch_data, WorksheetFunction _ .Find(data, actvdata, n), Len(data), data_2(i)) If Err.Number = 1004 Then MsgBox "その式は成立しまへん!", vbExclamation Err.Clear On Error GoTo 0 Exit Sub End If n = WorksheetFunction.Find(data, actvdata, n) + Len(data_2(i)) _ - Len(data) + 1 swch_data = IIf(cmb1 = "値", ActiveCell.Value, ActiveCell.Formula) actvdata = StrConv(StrConv(swch_data, vbWide), vbUpperCase) Next u End If Next i End If Else For i = 0 To UBound(data_1) data = StrConv(StrConv(data_1(i), vbWide), vbUpperCase) .Pattern = data .Global = True If .test(actvdata) Then n = 1 For u = 1 To .Execute(actvdata).Count ActiveCell = WorksheetFunction.Replace(swch_data, WorksheetFunction _ .Find(data, actvdata, n), Len(data), txtbox.Text) n = WorksheetFunction.Find(data, actvdata, n) + Len(txtbox.Text) - Len(data) + 1 actvdata = StrConv(StrConv(swch_data, vbWide), vbUpperCase) Next u End If Next i End If End With Else On Error Resume Next ActiveCell.Replace What:=テキスト.Text, Replacement:=txtbox.Text, _ LookAt:=IIf(c_3, xlWhole, xlPart), SearchOrder:=IIf(cmb = "行", _ xlByRows, xlByColumns), MatchCase:=IIf(c_1, True, False), _ MatchByte:=IIf(c_2, True, False) ActiveCell.Select End If Else txtbox.Visible = True Lbl.Visible = True txtbox.SetFocus flg = True 全て置き換え.Visible = True End If On Error GoTo 0 End Sub Private Sub 閉じる_Click() Unload Me End Sub Private Sub UserForm_Initialize() Dim obj As Object With Me .Width = 330 .Height = 140 .Caption = "スペシャル検索" End With With Controls.Add("forms.label.1", , True) .Top = 8 .Left = 15 .Height = 12 .Width = 150 .Caption = "検索文字列（ _ で区切ると複数可能）" End With Set テキスト = Controls.Add("forms.textbox.1", , True) With テキスト .Name = "テキスト" .Top = 21 .Left = 12 .Height = 15 .TabIndex = 0 .Width = 220 .ControlTipText = "複数検索のばやいは 「_」 で区切って入力" End With Set txtbox = Controls.Add("forms.textbox.1", , True) With txtbox .Name = "txtbox" .Top = 52 .Left = 12 .Height = 15 .Width = 220 .Visible = False End With Set Lbl = Controls.Add("Forms.Label.1", , True) With Lbl .Top = 40 .Left = 15 .Height = 12 .Width = 150 .Caption = "置き換え文字列" .Visible = False End With With Controls.Add("forms.label.1", , True) .Top = 75 .Height = 12 .Left = 12 .Width = 42 .Caption = "検索方向" End With Set cmb = Controls.Add("forms.combobox.1", , True) With cmb .Top = 70 .Left = 66 .Height = 18 .Width = 54 .AddItem "行" .AddItem "列" .Text = .List(0) End With Set check_1 = Controls.Add("forms.checkbox.1", , True) With check_1 .Height = 13 .Left = 132 .Top = 68 .Width = 102 .Caption = "大文字小文字を区別する" End With Set check_2 = Controls.Add("forms.checkbox.1", , True) With check_2 .Height = 13 .Left = 132 .Top = 82 .Width = 102 .Caption = "全角半角を区別する" End With Set check_3 = Controls.Add("forms.checkbox.1", , True) With check_3 .Height = 13 .Left = 132 .Top = 98 .Width = 102 .Caption = "完全一致の検索" End With Set 検索 = Controls.Add("forms.commandbutton.1", , True) With 検索 .Height = 17 .Left = 260 .Top = 13 .Width = 50 .Caption = "検 索" .TabIndex = 1 End With Set 閉じる = Controls.Add("forms.commandbutton.1", , True) With 閉じる .Height = 17 .Left = 260 .Top = 36 .Width = 50 .Caption = "閉じる" End With Set 置き換え = Controls.Add("forms.commandbutton.1", , True) With 置き換え .Height = 17 .Left = 260 .Top = 60 .Width = 50 .Caption = "置き換え" End With Set 全て置き換え = Controls.Add("forms.commandbutton.1", , True) With 全て置き換え .Height = 17 .Left = 260 .Top = 84 .Width = 50 .Caption = "全て置き換え" .Visible = False End With Set cmb1 = Controls.Add("forms.combobox.1", , True) With cmb1 .Top = 90 .Left = 66 .Height = 18 .Width = 54 .AddItem "値" .AddItem "数式" .Text = .List(0) End With With Controls.Add("forms.label.1", , True) .Top = 95 .Left = 12 .Height = 12 .Width = 42 .Caption = "対象" End With End Sub ---- 皆様ありがとうございます。 弥太郎さんのはすごいですね。 勉強不足の私には、半分ぐらいしか理解が出来ませんでした。 HANAさんの言うとおり確かに、だいたい・・・がくせものですね。 実際の物の1部です。 C→CD CIF→CL R→RG RC→RCのまま と、言ったようにしたいのですが、今は C→CD CIF→CDIF R→RG RC→RGCD となっていました。 独覚さんのLookAt:=xlWholeで対応できました。 完全一致の変換。新しい知識が増えました。 ありがとうございます。 (shinmaipapa)... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/200812/20081219111246.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97059 documents and 608315 words.
訪問者：