[[20210925185308]]　『VBA　一致検索』（よっち）　ページの最後に飛ぶ

『VBA　一致検索』（よっち）

お世話になります。
VBAで一致検索して転記するコードがわからずご教示いただきたいです。

sheet1とsheet2があります。
sheet1のA2～A10に1～10の番号があり、B2～B10にりんご、もも、なしがランダムに表示されています。これをりんごの番号のみsheet2のA列2行目から転記したいです。ｱｸﾃｨﾌﾞｼｰﾄはsheet2です。

この場合Loop処理になるのでしょうか？
コードをご教示いただけると幸いです。

＜使用 Excel：unknown、使用 OS：unknown ＞

 Sub Macro1()
    With Worksheets("Sheet1")
        With Range(.Cells(1, "A"), .Cells(Rows.Count, "B").End(xlUp))
            .AutoFilter Field:=2, Criteria1:="りんご"
            .Resize(, 1).Offset(1).Copy Worksheets("Sheet2").Range("A2")
            .AutoFilter
        End With
    End With
 End Sub

 Sub Macro2()
    Dim rng As Range
    Dim i As Long
    With Worksheets("Sheet1")
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            With .Cells(i, 2)
                If .Value = "りんご" Then
                    If rng Is Nothing Then
                        Set rng = .Offset(, -1)
                    Else
                        Set rng = Union(rng, .Offset(, -1))
                    End If
                End If
            End With
        Next i
    End With
    rng.Copy Worksheets("Sheet2").Range("A2")
 End Sub
（xxx） 2021/09/25(土) 21:29

既に明解案がありますが、　ついでに。
Sheet1の一行目に、"番号","品名"の見出しがあるものとして、
フィルタオプションの使用例です。

 Sub test()
     With Sheets("Sheet2")
         .Range("A1") = "番号"
         .Range("C1") = "品名": .Range("C2") = "りんご"
         Sheets("Sheet1").Range("A1:B10").AdvancedFilter _
             Action:=xlFilterCopy, _
             CriteriaRange:=.Range("C1:C2"), _
             CopyToRange:=.Range("A1"), Unique:=False
     End With
 End Sub

学習の順序としては、
Macro2 > Macro1 ( >> test )
でしょうか。
（γ） 2021/09/25(土) 21:56

 学習の順序としては、まずこれをかけるようになるのが最初かなぁと
 おもいます。

 Sub firstStep()
   Dim i As Long, j As Long
   j = 2
   For i = 2 To 10
     If Worksheets("Sheet1").Cells(i, "B").Value = "りんご" Then
        Worksheets("Sheet2").Cells(j, "A").Value = Worksheets("Sheet1").Cells(i, "A").Value
        j = j + 1
     End If
   Next
 End Sub
（´・ω・`） 2021/09/26(日) 00:40

 Sub Find_Apple()

    Dim R As Range
    Dim TemSave As Range
    Dim SearchRng As Range

    Set SearchRng = Sheets(1).Range("B:B")
    Set R = SearchRng.Find("りんご")
    Set TemSave = R

    Do While Not R Is Nothing
            ' Debug.Print R.Row
            ' MsgBox R.Address
            Sheets(1).Range(R.Address, Range(R.Address).Offset(0, -1)).Copy _
            Sheets(2).Range(R.Address).Offset(0, -1)
            Set R = SearchRng.FindNext(R)
            If R.Address = TemSave.Address Then
                Exit Do
            End If
    Loop
 End Sub

  σ(｡・ω・｡) 私も、こんなのスラスラ全く書けませんが…以前に勉強してたのが
 あったのでご参考までにどうぞ。無限ループにご注意を…

 https://valmore.work/vba-find-next/
 https://okwave.jp/qa/q8873915.html

（あみな） 2021/09/26(日) 08:21

 ♪(；ﾟ∀ﾟ) ｱｯ ｱｸﾃｨﾌﾞｼｰﾄはSheet2からか...

 Sheet1からでないとエラーなるわぁｗ　無視してください^^;
（あみな） 2021/09/26(日) 08:35

推奨する学習の順序はご指摘のとおりでした。
コードをよく見ていませんでした。ペコリ。

firstStep >> Macro2 > Macro1 = test

firstStepに続けて、
・ワークシート変数の利用
・Withの利用とか、
そういう順序でしょうか。

なお、多数の行数があるときに、Macro2はUnion利用の実行負荷が結構あるかもしれません。
フィルタオプションは、Excelの機能そのものなので、負荷は軽くすむかもしれません。
（ちゃっかり、>> test を修正）
（γ） 2021/09/26(日) 12:15

ああ、それと
＞ｱｸﾃｨﾌﾞｼｰﾄはsheet2です。
とありますが、どのシートがアクティブかに依存しないコードを書くべき、
という考え方の理解も並行してされるとよいでしょう。
（γ） 2021/09/26(日) 12:20

 ﾒﾓﾒﾓ. φ(-ω-) ｶｷｶｷ

 どのシートがアクティブかに依存しないコードを書くべきという考え方の理解も並行する。
  (*-ω-)ﾉ ﾊｰｲ ...メンテナンス性も考えないとですね。

（あみな） 2021/09/26(日) 14:27

コメント返信：

[ 一覧(最新更新順) ]

[[20210925185308]] 『VBA 一致検索』（よっち） ページの最後に飛ぶ

[[20210925185308]]　『VBA　一致検索』（よっち）　ページの最後に飛ぶ