[[20150817165312]]　『VBA 検索コピー貼り付けをしたい』（菊子）　ページの最後に飛ぶ

『VBA 検索コピー貼り付けをしたい』（菊子）

ご教示お願いします。

■やりたい内容下記セルがある場合 "aaa*"で検索し、HITした"aaa1"を貼りつける。これを上から順に行いたい。
(aaa2は無いものとします)

aaa1
bbb2
ccc3

お忙しい中、初歩的な事ですみません。マクロを組んでいる最中ですが苦慮しております。宜しくお願い致します。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 どこに貼り付けるんですか？

 それと、

 >>aaa2は無いものとします

 この意味は？　あろうがなかろうが、１件ヒットして貼り付ければ終わりということですか？
 それにしては

 >>これを上から順に行いたい。

 なんですよね？　ということは順に処理して、aaaなんたら　があれば、それも処理するということでは

（β） 2015/08/17(月) 17:22

説明不足で申し訳ございません。

どこに貼り付けるんですか？

C列へ上から順に貼りつけます

aaa2は無いものとします
上から順に検索をするマクロで
aaa2
aaa1
とある場合のifを考える必要が無いと記載したかったのです。

宜しくお願い致します。
（菊子） 2015/08/17(月) 17:49

 一例です。

 Sub Test()
    Dim i As Long
    Dim c As Range

    Columns("C").ClearContents

    For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
        If c.Value Like "aaa*" Then
            i = i + 1
            Cells(i, "C").Value = c.Value
        End If
    Next

 End Sub

（β） 2015/08/17(月) 18:33

 上記で充分だとは思いますが、エクセルの検索機能を使った例もアップします。

 Sub test2()
    Dim c As Range
    Dim f As Range
    Dim r As Range
    Dim pos As Range

    Columns("C").ClearContents

    Set r = Range("A1", Range("A" & Rows.Count).End(xlUp))
    Set pos = Range("C1")

    Set c = r.Find(What:="aaa*", LookAt:=xlWhole, After:=r.Cells(r.Count))
    If c Is Nothing Then Exit Sub

    Set f = c

    Do
        pos.Value = c.Value
        Set pos = pos.Offset(1)
        Set c = r.FindNext(c)
    Loop While c.Address <> f.Address

 End Sub

（β） 2015/08/17(月) 18:44

お忙しい中ありがとうございました。
コメントが遅くなり申し訳ございません。

業務の都合で暫く確認出来無いのですが時間が空き次第確認します。

（菊子） 2015/08/19(水) 08:53

ご教示ありがとうございました。
早速試したのですが、うまくＣ列へ反映が出来ず苦慮しております。

現状

  検索範囲がA列と別シート("ZZZ")にいます。同じデータです
    （一つにしたいのですが記載方法が分かりませんでした）
  B列には検索値があります
  C列に結果を入力したいです

お忙しい中申し訳ございませんがご教示頂きたく、宜しくお願い致します。

Dim dir
Dim BIR
Dim i As Long
Dim c As Range

DIRL = Range("B1").End(xlDown).Row '検索値の設定
dir = Worksheets("ZZZ").Range("B3").End(xlDown).Row '検索範囲の設定

    Columns("C").ClearContents
    BIR = Worksheets("ZZZ").Range("B3").End(xlDown).Row '

    For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp)) '検索範囲の設定 = dirに変更?

        For i = 2 To DIRL                                        '検索値を最終行までFINDする

        If c.Value Like Range("B" & i) = BIR Then               '見つかった場合
            i = i + 1
            Cells(i, "C").Value = c.Value
        Else '見つからない場合

        End If
    Next
Next

End Sub
（菊子） 2015/08/21(金) 09:18

もう少し、わかりやすく説明いただけますか。

 ＞ 検索範囲がA列と別シート("ZZZ")にいます。同じデータです
 ＞   （一つにしたいのですが記載方法が分かりませんでした）

（マナ） 2015/08/21(金) 22:08

マナ様

お忙しい中ありがとうございます。
初心者故、何をお伝えすれば良いか分かっていない為申し訳ございません。

＞検索範囲がA列と別シート("ZZZ")にいます。同じデータです
＞（一つにしたいのですが記載方法が分かりませんでした）
検索範囲をA列としました。分かりにくく申し訳ございません。

A列に、検索範囲があります。
B列に、検索値があります。
C列に、検索結果を書き込みたいです

AAA1 AAA*
BBB2 CCC*
CCC3
・
・
・

上記データがある場合のＣ列に書き込むマクロを作成しましたがうまく反映出来ませんでした。
ご教示頂きたく、宜しくお願い致します。

Dim dir
Dim BIR
Dim i As Long
Dim c As Range

DIRL = Range("B1").End(xlDown).Row '検索値の取得
dir = Range("A1").End(xlDown).Row '検索する範囲

    Columns("C").ClearContents

    For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))  '検索する範囲=dirと同じ

        For i = 1 To DIRL      '検索値の取得

            If c.Value Like Range("B" & i) = dir Then   '検索結果がある場合Ｃ列へ書き込み

            i = i + 1
            Cells(i, "C").Value = c.Value
        Else '見つからない場合何もしない

        End If
    Next
Next

 MsgBox "終了しました"

（菊子） 2015/08/24(月) 10:10

 >>検索範囲がA列と別シート("ZZZ")にいます。同じデータです 
 >> （一つにしたいのですが記載方法が分かりませんでした）

 やはり、この意味がわかりません。
 （菊子） 2015/08/24(月) 10:10　のコードから推測しようと思ったんですが、コードでは
 Sheets("zzz") というものが全く登場していませんので、ちんぷんかんぷんです。

 「同じデータです」という文章も？？
 何が何と同じなんですか？

 「一つにしたいのですが」という意味も？？　何と何を１つにしたいのですか？
 でその、わからない「記載方法」とは？　掲示板上での説明の記載方法？
 コードの「記述方法」？？

 それと、テーマとは離れますが、エラーにはならないといえど、dir という変数名を使うのは感心しません。

（β） 2015/08/24(月) 16:23

 コメントした通り、仕様や要件がわからないのですが、複数のシートが関係しているとして

 ・あるシートのレイアウト（具体例付）
 ・別のシートのレイアウト（具体例付）

 これをまず説明して、次に、処理の結果、どのシートがどうなるか、これも具体例付でアップしていただけますか？

（β） 2015/08/24(月) 16:27

こんにちは

元データがシート「ZZZ」、検索条件と検索結果はシート「Sheet1」として、

Sub test()

    Dim r As Range
    Dim t As Range
    Dim f As Range
    Dim i As Long

    With Worksheets("ZZZ")
        Set t = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    End With
    i = 1
    With Worksheets("Sheet1")   '検索条件、結果シート
        For Each r In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
            Set f = t.Find(r.Value, t.Cells(t.Count, 1), xlValues, xlWhole, , xlNext)
            If Not f Is Nothing Then
                .Cells(i, 3) = f.Value
                i = i + 1
            End If
        Next
    End With
End Sub

という事でしょうか？

（ウッシ） 2015/08/24(月) 16:40

β様
ご教示頂きありがとうございます。
次回よりdirは使用しないようにします。

ウッシ様
マクロが動き記載出来ました!!ありがとうございました。
（菊子） 2015/08/24(月) 17:36

コメント返信：

[ 一覧(最新更新順) ]

[[20150817165312]] 『VBA 検索 コピー 貼り付け をしたい』（菊子） ページの最後に飛ぶ

[[20150817165312]]　『VBA 検索コピー貼り付けをしたい』（菊子）　ページの最後に飛ぶ