痔になりやすい生活習慣とは?

同一セル内での重複削除

今手元にとあるデータがあります。
そのデータは同一セル内に「○○株式会社/■■印刷/▼▼株式会社/○○株式会社」のように、スラッシュ区切りで会社名が入っています。
このデータから、重複している会社名を削除したいと考えています。上記の例ですと「○○株式会社」が重複していますので、これを削除し「○○株式会社/■■印刷/▼▼株式会社」としたいです。
データが大量にあるので、関数を使用するよりも、マクロを使用した方が時間的にも作業量的にも楽だと思うのですが、いまいちどうやって良いか分かりません。

要約しますと、同一セル内にある重複データを削除するマクロを作れるのか、作れるならばどのようなものか、ということを教えていただきたいと思います。
また、もし削除した際に「・・・・・/」と末尾がスラッシュになった場合、最後のスラッシュだけを削除する方法も教えていただければうれしいです。
ちなみに、会社名の順序に意味はありませんので、重複したデータの1つめを削除するのか、2つめを削除するのかは気にしていません。

どなたかお願いいたします。

このQ&Aに関連する最新のQ&A

A 回答 (4件)

お邪魔します。



ワークシート用を兼ねた関数です。
標準モジュールに貼り付けます。

シートからは、数式として、
 =myfFiltUniq(A1,"/")
のように書きます。
 もし、
 "ABC/abc/ABC/abc"を第一引数に渡して、"ABC"だけ(最左だけ)を返す場合は、
 =myfFiltUniq(A1,"/",1)
 とします。
 第三引数を省略(規定値は0)すると"ABC/abc/ABC/abc"が返ります。
(VBAでの扱いも殆ど同じですし、むしろ易しいはずです。)
(エラーを出そうと思って使うならバグが無いでもないですが対策は省きます。)

方法は色々あると思いますが、パフォーマンス云々は抜きにして、
用途に合った-Filter()関数の使い方-をメインにした、レス、です。
(使う機会がなかなか無い↑ので、、、ここぞとばかり(^^;)

Function myfFiltUniq(ByVal Source As String, Delimiter As String, _
    Optional Compare As VbCompareMethod = vbBinaryCompare)
  Dim vArr As Variant
  Dim sTmp As String
  vArr = Split(Source, Delimiter)
  If UBound(vArr) < 1 Then
    myfFiltUniq = Source
    Exit Function
  End If
  Do
    If vArr(0) = "" Then
      vArr(0) = vbNullString
    Else
      sTmp = sTmp & Delimiter & vArr(0)
    End If
      vArr = Filter(vArr, vArr(0), False, Compare)
  Loop While -1 < UBound(vArr)
  myfFiltUniq = Mid$(sTmp, 2)
End Function


===============================================================================
    • good
    • 0
この回答へのお礼

ありがとうございました。

ほかにもお二方から御回答をいただきましたが、自分でも好みに改変しやすい、データに加工が必要ない、この2点でベストアンサーに選ばせていただきました。

お礼日時:2010/07/28 14:47

こんにちは、レスをありがとうございます。


質問締切から時間が経っていますが、必要と考え、追加回答をさせて頂くことにしました。
 (#許されるなら回答の差し替えをお願いしたいのですが#)
私が書いた”回答 No.3 ”に不具合があった為、です。
恐れ入りますが、以下の説明をお読みいただいた上で、
”回答 No.3 ”提示の関数を差し替えてくださいますようお願いします。
ご迷惑をお掛けしてすみません。
 
<不具合の内容>
|”回答 No.3 ”提示の関数は、部分的な一致を重複と解釈して削除してしまうという問題がありました。
| Ex.)
|  ”△△HD/△△/△△東日本/△△西日本”
|  →”△△HD/△△”
|  ”□□株式会社/平成□□株式会社/昭和□□株式会社/南□□株式会社/新□□株式会社”
|  →”□□株式会社”
|以上のように意図しない結果を返してしまう場合があります。
細かな仕様にばかり拘って基本的な確認を怠ってしまった私のミス(ポカ)です。ごめんなさいm(__)m
<検討すべき点>
|本来は、完全な一致のみ重複削除するのが、当然ながら基本です。
|その上で、或いは要求に応える形での仕様として、
| Ex.)「前方一致するものを重複削除」
|  ”(株)○○/(株)○○・事業部/(株)○○・総務部”
|  →”(株)○○”
|のような抽出が出来るように、(ソート機能を追加した上で)
| [一致(=T)|前方一致(T*)|後方一致(*T)]|前方一致(*T*)]
|の中から選べる機能を持たせる場合もあるかもしれません。
|しかしながら、今回の案件についてはそもそも、そこまでの必要はないようです。
現実でのやりとりなら双方向でニーズの確認と提案が容易にできるのですが、BBSを甘く見ていたかもしれません。
<手当て>
|以上のような理由で関数の作り直しに取り掛かかり、拙いながらも20パターン程実際に書いてみました。
|記述の簡潔さと処理能力とで中庸のバランスを取った関数(という意図で書いたもの)を再提示します。
|使い方(機能)は前提示と変わりありませんが、
|部分一致で重複削除されないように正しました(多少の改良を加えたつもりです)。
色々な意味で勉強する(反省する)よい機会を与えてくださった質問者様に感謝しております。ありがとうございました。
<数式での使用例>
|Ex.1)
| A1: "ABC/abc/ABC//abc/ABC/アカサ/アカサ/abcD/Zabc/アカサ/"
| =myfFU(A1,"/")
|  → "ABC/abc/abc/ABC/アカサ/アカサ/abcD/Zabc"
| =myfFU(A1,"/",1)
|  → "ABC/アカサ/abcD/Zabc"
| ※↑この場合、一致するものの中で最初(最も左)にあるものが抽出されます※
|Ex.2) 第三引数に依らず
| A1: "/" (または、A1: 空白セル)
|  → ""
|Ex.3) 第三引数に依らず
| A1: "ABC" 
|  → "ABC"
 
<関数の再提示>
' ' ==========================注意事項==========================
Excel2000/2003 にて動作確認しました。
標準モジュールに下記のコードをコピペしてください。
VBAの記述の冒頭部分は
モジュールの先頭にある(上に何も書かれていない)ことが必要です。
また、Enum から End Enum までの部分は一箇所にしか書けませんので
重複しないようにしてください。
混乱を避ける意味で関数名を変えています。
既にシート上でお使いの場合は置換機能を使って関数名を一括置換してください。
' ' ===========================ここから===========================
Option Explicit
Enum myCompareMethod
    myBinaryCompare ' = 0
    myTextCompare ' = 1
End Enum
' ' ============================================================
Function myfFU(ByVal 文字列 As String, ByVal 区切り文字 As String, _
        Optional ByVal TextCompare As myCompareMethod = myBinaryCompare) As String
If TextCompare Then TextCompare = myTextCompare
    Dim A As Variant
    Dim S As String
    Dim N As Long
    If 文字列 = "" Then Exit Function
    A = Split(文字列, 区切り文字) ' LBound 0
    A = Application.Text(A, """" & 区切り文字 & """@""" & 区切り文字 & """") ' LBound 1
    A = Filter(A, String$(2&, 区切り文字), False, vbBinaryCompare) ' LBound 0
    S = String$(Len(文字列) + 2&, 区切り文字)
    N = 1&
    Do While UBound(A) > -1&
        Mid(S, N) = A(0)
        N = InStr(N + 1&, S, 区切り文字)
        A = Filter(A, A(0), False, TextCompare)
    Loop
    If N > 1& Then myfFU = Mid$(S, 2&, N - 2&)
    Erase A
End Function
' ' ===========================ここまで===========================
    • good
    • 0

重複データを削除する関数を作ってみました。



Function 重複削除(S As String) As String
Dim i As Integer
Dim j As Integer
Dim S1() As String
Dim S2 As String
Dim Exist As Boolean

S1() = Split(S, "/")
S2 = S1(0)
For i = 1 To UBound(S1)
Exist = False
For j = 0 To i - 1
If S1(i) = S1(j) Then
Exist = True
Exit For
End If
Next
If Not Exist Then S2 = S2 & "/" & S1(i)
Next
重複削除 = S2
End Function


あとは、対象のセルでこの関数を適用してください。

Sub test()
Cells(1, 1) = "○○株式会社/■■印刷/▼▼株式会社/○○株式会社"
Cells(1, 2) = 重複削除(Cells(1, 1))
MsgBox Cells(1, 2)
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございました。


御回答いただいた方法もよかったのですが、No.3の方をベストアンサーとさせていただきました。
今後も、何かあった際は、ご指導、ご鞭撻のほどよろしくお願い申し上げます。

お礼日時:2010/07/28 14:52

こんばんは!


参考になるかどうか判りませんが・・・

無理やりって感じの方法です。
元データがSheet1にあるとします。
元データが変わってはまずいと思いますので、Sheet1すべてをSheet2にコピー&ペーストして
Sheet2上(別にSheet2でなくても構いません)で試してみてください。

当方使用のExcel2003の場合です。
貼り付けがデータがSheet2のA列にデータがあるとします。
A列を範囲指定 → データ → 区切り位置 → 「カンマやタブなどの・・・」を選択 
→ 次へ → 「その他」にチェックを入れ「/」を入力 → 次へ → 完了
これで「/」なしで列方向の各セルに区切られますので、
↓のコードをSheet2のシート見出し上で右クリック → コードの表示 を選択し
コピー&ペーストしてマクロを実行してみてください。

Sub test()
Dim i, j As Long
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To ActiveSheet.UsedRange.Columns.Count
If WorksheetFunction.CountIf(Range(Cells(i, 1), Cells(i, j)), Cells(i, j)) > 1 Then
Cells(i, j).Delete (xlToLeft)
End If
Next j
Next i
Dim k, l As Long
Dim str As String
For k = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For l = 1 To Cells(k, Columns.Count).End(xlToLeft).Column
str = str & "/" & Cells(k, l)
Cells(k, l).Clear
Next l
Cells(k, 1) = WorksheetFunction.Replace(str, 1, 1, "")
str = ""
Next k
End Sub

以上、参考になれば良いのですが
他に良い方法があれば読み流してくださいね。m(__)m
    • good
    • 0
この回答へのお礼

ありがとうございました。


御回答いただいた方法もよかったのですが、No.3の方をベストアンサーとさせていただきました。
今後も、何かあった際は、ご指導、ご鞭撻のほどよろしくお願い申し上げます。

お礼日時:2010/07/28 14:52

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qエクセル セル内の重複する文字列を削除する方法

エクセルでセル内の重複する文字列を削除する方法を教えてください。


例えばA1のセルに次のような文字列があります

斎藤(18)
武田(21)
稲葉(41)
田中(3)
斎藤(18)
金子(8)
田中(3)

この中で重複している文字列(斎藤(18)田中(3))を削除し、以下のようにしたいと思います。

斎藤(18)
武田(21)
稲葉(41)
田中(3)
金子(8)

区切り位置にはカンマやスペースは入ってません。
(改行コードは入ってます)
わかる方おられましたら教えていただけますと幸いです。

よろしくお願いいたします。

Aベストアンサー

A1セル以下、A列にデータがあるとして、変換結果をB列に書き出します。
連想配列のキーの配列をまとめるのに、Joinが使ってみたかっただけです。
重複チェックするデータ数が今回程度では、速度上のメリットもないかもしれませんが、ご参考まで。
Sub test()
Dim myCell As Range, targetRange As Range
Dim buf As Variant
Dim i As Long
Dim myDic As Object

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ActiveSheet
Set targetRange = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
End With
Set myDic = CreateObject("Scripting.Dictionary")
For Each myCell In targetRange.Cells
buf = Split(myCell.Value, vbLf)
For i = LBound(buf) To UBound(buf)
If Not myDic.Exists(buf(i)) Then myDic.Add buf(i), ""
Next i
myCell.Offset(0, 1).Value = Join(myDic.keys, vbLf)
myDic.RemoveAll
Next myCell
Set myDic = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

A1セル以下、A列にデータがあるとして、変換結果をB列に書き出します。
連想配列のキーの配列をまとめるのに、Joinが使ってみたかっただけです。
重複チェックするデータ数が今回程度では、速度上のメリットもないかもしれませんが、ご参考まで。
Sub test()
Dim myCell As Range, targetRange As Range
Dim buf As Variant
Dim i As Long
Dim myDic As Object

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ActiveSheet
Set targetRange = .Rang...続きを読む

Qエクセルのセル内の重複文字列処理について

よろしくお願いいたします。
セル内にスペースで区切られた文字列(単語)があり、文字列の数は不確定です。
その文字列の中で重複する文字列があり、それらを1つにまとめたいという要望です。
セルの行数は約6000ほどあります。



A1セル:リンゴ リンゴ みかん
B1セル:リンゴ みかん
A2セル:みかん バナナ みかん バナナ みかん
B2セル:みかん バナナ
・・・

よろしくお願いいたします。

Windows7 HomePremium
Office2010

Aベストアンサー

こんばんは!
VBAになってしまいますが、一例です。

データは1行目からあるとします。

画面左下の操作したいSheet見出し上で右クリック → コードの表示 → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)

Sub test() 'この行から
Dim i As Long
Dim k As Long
Dim tmp As Variant
Dim myArray As Variant
Application.ScreenUpdating = False
Columns(2).ClearContents
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
tmp = WorksheetFunction.Substitute(Cells(i, 1), " ", " ")
If InStr(tmp, " ") > 0 Then
myArray = Split(tmp, " ")
For k = 0 To UBound(myArray)
If InStr(Cells(i, 2), myArray(k)) = 0 Then
Cells(i, 2) = Cells(i, 2) & myArray(k) & " "
End If
Next k
Else
Cells(i, 2) = Cells(i, 1)
End If
Next i
Application.ScreenUpdating = True
End Sub 'この行まで

こんな感じではどうでしょうか?m(_ _)m

こんばんは!
VBAになってしまいますが、一例です。

データは1行目からあるとします。

画面左下の操作したいSheet見出し上で右クリック → コードの表示 → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)

Sub test() 'この行から
Dim i As Long
Dim k As Long
Dim tmp As Variant
Dim myArray As Variant
Application.ScreenUpdating = False
Columns(2).ClearContents
For i = 1 To Cells(Rows.Cou...続きを読む

Q同一セル内で重複した特定の文字を削除したい

Windows8.1、Excel2013です。

セル内に同一の文字列が複数出てくる場合に2つめ以降を全て削除したいです。
該当の文字列は複数ありますが、限定されています。

例えば

ABC犬DEやぎGH犬IJK山羊LM犬N
↓2回目以降の「犬」「やぎ」を削除
ABC犬DEやぎFGHIJKLMN

わかりにくくて申し訳ございませんが、初心者のためお知恵拝借できないでしょうか?

Aベストアンサー

事例が1つだけしか紹介されていないのに その事例がおかしいものだと
どういう条件なのかさっぱり分からなくなります。

> ↓2回目以降の「犬」「やぎ」を削除
> ABC犬DEやぎFGHIJKLMN
「ぎ」と「G」の間に「F」が追加された理由は何ですか?
「やぎ」が削除になる理由は何ですか?
その結果として「山羊」が削除されたのは何故ですか?

> わかりにくくて申し訳ございませんが
わかりにくいと分かっているなら もっと丁寧に説明すべきかと思います。
質問のわかりにくさは初心者かどうかの問題ではないので。

QエクセルのIF関数で、文字が入力されていたならば~

エクセルのIF関数で文字が入力されていたならば~、という論理式を組み立てたいと思っています。

=IF(A1="『どんな文字でも』","",+B1-C1)

A1セルに『どんな文字でも』入っていたならば、空白に。
文字が入っていなければB1セルからC1セルを引く、という状態です。

この『どんな文字でも』の部分に何を入れればいいのか教えてください。

またIF関数以外でも同様のことができれば構いません。

宜しくお願いします。

Aベストアンサー

=IF(ISTEXT(A1),"",B1-C1)

でどうでしょうか?

Qエクセル 同一セル内の特定文字列のある行だけを削除する

現在、同一セル内の特定文字列に 名前[*] を指定してこれのある行の削除のマクロを数百セルに行っています。
しかし今回 名前:* という形のみとなり、] が無くなった事でこれを特定文字列と指定して行の削除を行うと、同一セル内のこれ以降の行も全て削除される状況となりました。
セルの数は1日数百のため手動で ] を入力する事は出来ません。
どうか上記の特定文字列のある行の削除する方法のアドバイスをいただけたら幸いです。

よろしくお願い致します。

Aベストアンサー

ひとつのセルに中に、「氏名:浦島太郎 住所:鬼ヶ島…」のように入力されていて、そこから氏名部分を削除して、「住所:鬼ヶ島…」にしたいということでしょうか?
であれば、「氏名:* 」としてみて下さい(*の後ろに空白を入れる)。
要するに、氏名部分とその後に続く文字列との間の区切り文字(上記の場合は空白)まで指定するということです。
例えば、「氏名:浦島太郎/住所:鬼ヶ島…」となっているのであれば、「氏名:*/」となります。

もし後ろに続く文字列が決まっているのであれば(上記の場合は、「住所」)、そこまで指定しても良いと思います。
具体的に言うと、「氏名:*住所」→「住所」に置換するイメージです。

QExcel 書式を関数で判断。

Excelで、「もしA1が緑色ならば」などと、書式を関数で判断させるにはどうすればよいのでしょうか。

Aベストアンサー

#1の回答通り関数はありません。マクロでなら可能です。

ここでは「色の付いたセルを合計」という質問が結構出ています。
http://okwave.jp/kotaeru.php3?q=2000523

Q文字列(セル)から一部の文字だけ削除する方法

質問させて頂きます。

エクセル等で下記のような編集をしたいと考えております。

A列      A列
12345     123
67890     678
01234  ⇒  012
56789     567
98765     987

ようは、右側の2文字などを指定して削除をする方法です。

少し説明が分かり辛いかもしれませんが、もし、分かりましたら、ご教授いただければ、幸いです。

どうぞ、宜しくお願い致します。

Aベストアンサー

右側の2文字を削除するなら、セルA1に文字が入っているとき
=LEFT(A1,LEN(A1)-2)
とすれば、取り出せます。
「LEFT」関数は文字列の左側から指定文字数分取り出す関数。
「LEN」関数は、指定文字列の長さを計算してくれる関数です。
なので、左側から「文字数-2」文字取り出せば質問のとおりになります。

Qエクセルで条件に一致したセルの隣のセルを取得したい

下のような「得点」という名前のシートがあります。
(「田中」のセルがA1です。)

 [ 田中 ][ 10 ][ 200 ]
 [ 山田 ][ 21 ][ 150 ]
 [ 佐藤 ][ 76 ][ 250 ]
 [ 鈴木 ][ 53 ][ 350 ]

別のシートのA1セルに、「佐藤」と入力すると、

 [ 佐藤 ]

「得点」シートから「佐藤」の列を見つけて、B1、C1に

 [ 佐藤 ][ 76 ][ 250 ]

のように表示させたいのですが、B1、C1にはどのような式を書けば良いのでしょうか。
「得点」シートでは氏名が重複する事はありません。
IF文を使うと思うのですが、いまいち良く分かりませんでした。

よろしくおねがい致します。

Aベストアンサー

こんにちは!
VLOOKUP関数で対応できます。
IF関数と併用すればエラー処理が可能です。

Excel2007以降のバージョンであれば
B1セルに
=IFERROR(VLOOKUP($A1,得点!$A:$C,COLUMN(B1),0),"")
としてC1セルまでオートフィルでコピー!
そのまま下へコピーすると行が2行目以降でも対応できます。

Excel2003までの場合は
=IF($A1="","",VLOOKUP($A1,得点!$A:$C,COLUMN(B1),0))

としてみてください、m(_ _)m

Q【エクセル】1列内に複数ある同項目を、各項目一つずつに絞る方法

お世話になります。

アクセスで各商品コードごとに、「各施設の価格一覧」
集計をとるための下準備(各コード、重複なく一つずつに
絞られたテーブルを作りたいです)として、
エクセルシート内で無秩序に複数ある各商品コードから、
それぞれ一つずつだけ列挙されたシートを作りたいです。

1万行を超えているので、「集計」でまとめても
意味がないだろうし、この場合の対応策について
皆目思い浮かばないのですが、
よろしければアドバイスいただけないでしょうか。

よろしくお願い致します。

Aベストアンサー

こんばんは。

Accessを使うのも結構なのですが、Excelでは、フィルタオプションを使います。

メニューから
[データ]-[フィルタ]-[フィルタオプションの設定]

 指定した範囲(O)
 リスト範囲(L) に範囲を入力
 抽出範囲は、適当に1つのセルを選択し、

 □重複するレコードは無視する(R)にチェック

 OK

で、ユニーク・データが取れます。

これは、ユニーク・データを取るためのExcelのデータベース機能です。

Q[初心者です]VBAで指定列からAを検索し、発見したら隣のセルに値0を入れるマクロ。

VBAで指定列からAを検索し、発見したら隣のセルに0を入れるマクロを組みたいのですが、組み方がVBA初心者の為わかりません。
(例)
L列に、A、B、C、D、E、Fとランダムに文字が入っていて、
文字Aを検索し、発見したら隣のI列に値0を入れるというマクロです。

Sub Search()
Dim A As String
Set A = Worksheets("Sheet1").Cells.Find("A")
If A Is Nothing Then
ActiveCell.Offset(0, 1).Value = 0

End If
End Sub
と過去の質問で考えてみたのですが、Aがあった時、、、、
とコードが書けないです。
大変困っているので、ご教授頂けないでしょうか?
出来れば、そのままマクロに出来るコードを教えて頂けないでしょうか?
宜しくお願い致します。

Aベストアンサー

こんばんは。

#3さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

いずれ、また、同じようなケースが出会うと思います。こんな原則を考えてみたらどうでしょうか?それは、私も自身も同じなのですが、ワークシートのコマンドで行われるものは、記録マクロから作ってみるということです。他にも、「統合」とか、「置換」とか「オートフィルタ」「フィルタオプション」とかは、みんなパターンが決まっています。
その中の代表格が、この「Find」 です。

>Set A = Worksheets("Sheet1").Cells.Find("A")

>過去の質問で考えてみたのです

どうも、Find メソッドは、あるレベル以下の人は、省略する傾向があるようです。何が大事で、何が大事でないかというのは、やってみなければ分かりませんが、検索語だけを入れる書き方は、実務では、あまりしないほうがよいと思います。

だいたい、以下のTestFind2 ぐらいまでに、省略は、とどめたほうがよいです。

それは、Find は、必ずしも自分が思っているデフォルトとは違うことがあるので、「明示的(意図的に)」にオプションは入れたほうがよいです。
例えば、大文字小文字の違いを付けるなら、MatchCase:=True, 数式まで探すなら、LookIn:=xlFormulas

なお、Find メソッドは、5年経っても、たぶん完全に覚えられません。面倒なコードのひとつです。ですが、これはパターンが決まっているので、ひとつパターンが決まったら、それに当てはめればよいだけです。

#3さんで示されているMougのサンプルコードと似てはいるのですが、Mougのサンプルコードでは、Verionによって、失敗することがあります。

'--------------------------------------
'記録マクロをそのまま使う方法
Sub TestFind1()
Dim c As Range
 Set c = Columns("L:L").Find(What:="A", _
           After:=ActiveCell, _
           LookIn:=xlValues, _
           LookAt:=xlPart, _
           SearchOrder:=xlByRows, _
           SearchDirection:=xlNext, _
           MatchCase:=False, _
           MatchByte:=False, _
           SearchFormat:=False)
 c.Offset(0, 1).Value = 0
End Sub
'--------------------------------------
'TestFind1 をアレンジしてみる
Sub TestFind2()
Dim c As Range
'検索語
Const MYTXT As String = "A"
 Set c = ActiveSheet.Columns("L:L").Find(What:=MYTXT, _
           LookIn:=xlValues, _
           LookAt:=xlPart, _
           MatchCase:=False)
 If Not c Is Nothing Then
    c.Offset(0, 1).Value = 0
 End If
End Sub

'---------------------------------------
'複数ある場合(パターンを使った方法)
'---------------------------------------
Sub TestFind3()
  Dim c As Range
  Dim FirstAdd As String
  Const MYTXT As String = "A"
  Set c = ActiveSheet.Columns("L:L").Find( _
    What:=MYTXT, _
    LookIn:=xlValues, _
    LookAt:=xlPart, _
    MatchCase:=False)
  
  If Not c Is Nothing Then
    FirstAdd = c.Address
    Do
      c.Offset(, 1).Value = 0
      Set c = ActiveSheet.Columns("L:L").FindNext(c)
      If c.Address = FirstAdd Then Exit Sub
    Loop Until c Is Nothing
  End If
End Sub

こんばんは。

#3さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

いずれ、また、同じようなケースが出会うと思います。こんな原則を考えてみたらどうでしょうか?それは、私も自身も同じなのですが、ワークシートのコマンドで行われるものは、記録マクロから作ってみるということです。他にも、「統合」とか、「置換」とか「オートフィルタ」「フィルタオプション」とかは、みんなパターンが決まっています。
その中の代表...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング