（Excel VBA）困っています・・・orz

質問

エクセルを使うとある業務でマクロを組み、最適化を図ろうと試みているのですが
気がつけば高度な領域に突入していまして、僕みたいなレベルじゃ全然？？？な状況になってしまいました。

まず
A列の1行目から任意の行に（10行までしかなかったり、1000行まであったりとランダムにあるとする）、任意の文字列（ABCなど)があるとします。
それからオートフィルタを使い、A列からある任意の文字列（ABCなど）を検索条件にしてデータを抽出します。
抽出されたデータベースのA列には検索条件にある「ABC」が任意の行まであり、その抽出されたデーターベースのD列に今度は「XYZ」とという文字列を
抽出された分の最終行まで割り振る・・・

つまりA列《ABC》で検索され抽出されたデータのD列には《XYZ》が自動に入力される
もし、検索条件（ABC）で抽出されたデータが「0」件だった場合は、D列には何もせず、次の検索条件に進む・・・

というものをマクロで組みたいのですがどうやったらよいのでしょうか？？

何卒、ご教授お願い致します。

回答No.3

mitarashi · ベストアンサー

こんなもんでいかがでしょうか。SpecialCells(xlCellTypeVisible)も考えましたが、見つからないときの処理が面倒になりそうです。ご参考まで。
Sub test()
Dim targetRange As Range
Dim i As Long

Set targetRange = Range(Range("A1"), Range("A" & ActiveSheet.Rows.Count).End(xlUp))
With targetRange
.AutoFilter Field:=1, Criteria1:="ABC*"
For i = 2 To .Rows.Count
If .Cells(i).EntireRow.Hidden = False Then .Cells(i).Offset(0, 3).Value = "XYZ"
Next
End With
End Sub

お礼

mitarashiさん、ご回答ありがとう御座います。
素晴らしいです！
僕が求めていたのは当にこの様な動きです。
本当に皆さん天才ですね！頭が下がります・・・orz
余談ですが、質問時に一つ言い忘れていました。
D列に「XYZ」という文字列が自動に入力されるのと同時に
R列にも「1」という文字列が入る様に、、と書き忘れていました。。。orz
そこでmitarashiさんが書いて下さった構文からヒントを得てコピペしてみました。

Sub test()
Dim targetRange As Range
Dim i As Long

Set targetRange = Range(Range("A1"), Range("A" & ActiveSheet.Rows.Count).End(xlUp))
With targetRange
.AutoFilter Field:=1, Criteria1:="ABC*"
For i = 2 To .Rows.Count
If .Cells(i).EntireRow.Hidden = False Then .Cells(i).Offset(0, 3).Value = "XYZ"
If .Cells(i).EntireRow.Hidden = False Then .Cells(i).Offset(0, 17).Value = "1"
Next
End With
End Sub
そのまま拝借させて使わしてもらいます！
本当にありがとう御座います！m(_ _)m

回答No.6

hige_082

質問の処理を行うだけなら・・・

Sub test()
Dim 検索値 As String
Dim 入力値 As String
Dim i As Long

検索値 = InputBox("検索値を入力してください")
入力値 = InputBox("入力値を入力してください")

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If InStr(Cells(i, 1).Value, 検索値) = 1 Then Cells(i, 4).Value = 入力値
Next i

'抽出表示が必要なら、ここで抽出（オートフィルタ）すれば
'抽出だけの処理になるので簡単
End Sub

実用的なコードは他に回答があるので
考え方のヒントにでもなれば幸いです
参考まで

お礼

hige_082さん、ご回答ありがとう御座います。
ご返信が遅くなりましてすみません。

なるほど！この様な方法もあるのですね！
hige_082さんが書かれたプログラムもスッキリしていて綺麗で分かり易いですね！
とても参考になります！
実はまた解らない問題が2点ほど発生してしまいまして・・・
オートフィルタの複数条件でInputBoxを使った方法で対応出来るかどうかで、今現在自分なりに試行錯誤しているですが・・。
恐らくまた皆さんの天才的なお知恵を、恐れ多くもまたまたお借りするかも知れません...orz
書かれて下さったこの構文も、とても参考になります！
本当にどうもありがとう御座います！
徹夜明けなので頭の回転が悪く、文章が非常に拙く読み辛いかもしれませんが何卒お許し下さい。。。

回答No.5

myRange

先ず、基本的な方法から試してみたらどうでしょうか。

Ｇ列（２行目以降）に、検索文字
Ｈ列（２行目以降）に、置換文字
をそれぞれに必要分セットしておいて

'------------------------------------
Sub test()
　Dim R As Long
　Dim K As Long

　For R = 2 To Cells(Rows.Count, "A").End(xlUp).Row
　　　For K = 2 To Cells(Rows.Count, "G").End(xlUp).Row
　　　　　If Cells(R, "A").Value = Cells(K, "G").Value Then
　　　　　　　Cells(R, "D").Value = Cells(K, "H").Value
　　　　　End If
　　　Next K
　Next R

　MsgBox "終了"
End Sub
'---------------------------------

ま、こんな簡単なのはご存知でしょうから、質問の件になったのでしょうが、、
以上です。

お礼

myRangeさん、ご回答ありがとうございます。
いえいえとんでもないです、わざわざ私如きの質問にお知恵をお貸し頂いただけでも本当に嬉しいです！
余白のセルに必要分の値をセット・・・
それが出来たら本当に良かったのですが、仕様上、不可視な状態で組まなければならないので本当に困りものでした。。orz
ですが、皆さんが天才的なお知恵をご提供して下さったお陰で何とかなりそうです。
本当にありがとう御座います！m(_ _)m

回答No.4

ka_na_de

＃２です。

みつからなかった時の処理も必要なことを忘れてました。
改良してみましたので、ご参考までに。

Sub test2()
　　Dim myFindKey, mySetKey
　　Dim myLastRow As Long

　　With ActiveSheet
　　　　Do
　　　　　　If .AutoFilterMode Then .AutoFilterMode = False
　　　　　　myLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
　　　　　　myFindKey = Application.InputBox(prompt:="検索文字は？", Type:=2)
　　　　　　If myFindKey = False Then Exit Do
　　　　　　.Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=myFindKey
　　　　　　If .Range("A1:A" & myLastRow).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
　　　　　　　　mySetKey = Application.InputBox(prompt:="入力文字は？", Type:=2)
　　　　　　　　If mySetKey = False Then Exit Do
　　　　　　　　.Range("D2:D" & myLastRow).SpecialCells(xlCellTypeVisible).Value = mySetKey
　　　　　　　　Exit Do
　　　　　　End If
　　　　Loop
　　　　.AutoFilterMode = False
　　End With
End Sub

お礼

ka_na_deさん、ご回答ありがとうございます。
mitarashiさんのとも甲乙付けがたいほど、素晴らしい構文ですね！
特にインプットボックスがあるところについては、抽出するデータベースの文字列に変更があった場合は、柔軟に対応出来るところから、当に感嘆ものです！
本当に天才ですね皆さん！
・・・それに比べて僕なんてまだまだです orz
ka_na_deさんとmitarashiさんの2つのプログラムを両方とも採用させて頂く事にしました。
状況に応じて使い分けられるように少し改良させて頂きます！
皆さんにお忙しい中、本当にありがとう御座います！m(_ _)m

回答No.2

ka_na_de

オートフィルターを使った一例です。

一行目は見出し行である前提です。

参考になれば幸いです。

Sub test()
　　Dim myFindKey As String
　　Dim mySetKey As String
　　Dim myLastRow As Long

　　myFindKey = "ABC"
　　mySetKey = "XYZ"

　　myLastRow = Cells(Rows.Count, "A").End(xlUp).Row
　　With ActiveSheet
　　　　If .AutoFilterMode Then .AutoFilterMode = False
　　　　.Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=myFindKey
　　　　.Range("D2:D" & myLastRow).SpecialCells(xlCellTypeVisible).Value = mySetKey
　　　　.AutoFilterMode = False
　　End With

End Sub

回答No.1

bin-chan

> マクロで組みたいのですがどうやったらよいのでしょうか？？
「マクロの記録」を実行してコード生成させて、内容を検討して手直し。

ポイントは、
１）列Ａに対する条件である「任意の文字列」をどう受け取る？
２）列Ｄに設定する「任意の文字列」をどう受け取る？
３）「任意の文字列」に対する実行は終了はどう判定する？
４）任意の「入力行数」を知るにはどうする？

４）任意の「入力行数」を知るにはどうする？で行数さえわかれば、

　ａ）セルＤ１～セルＤ＜入力行数＞まで判定するループ処理を作成。
　ｂ）セルＤ＜対象行＞が設定されている（他条件の判定済）なら次行へ、
　　　セルＤ＜対象行＞が値設定されてないなら以下を実行後、次の行へ。
　ｃ）セルＡ＜対象行＞が判定条件に一致していれば、値を設定。
　ｄ）判定条件が終了でなければａ）へ戻る

ですかね。

お礼

ご回答ありがとう御座います。
そうなんです・・bin-chanさんの言う通り、僕も頭の中ではその概念で構成しているんですが、いざ構文で表す、、となると全然わかりません。。。orz
ちなみに
>４）任意の「入力行数」を知るにはどうする？で行数さえわかれば
これはRows.countで何とかなりませんかね？
A列の任意の行まで入力されている文字列（値）を入力されている最終行までの取得は出来るのですが
それを「ABC=XYZ」と判定し、D列にA列で抽出された分だけ「XYZ」を入れるという方法が如何せんどうしたものか...