[[20240802141520]]　『複数の条件の内1つでも合致したら転記』（関数がにがて）　ページの最後に飛ぶ

『複数の条件の内1つでも合致したら転記』（関数がにがて）

 こんにちは

 以前、教えていただいた物を改良して他のExcelで使用できないかと思ったのですが、
 抽出する条件が複数あり下記のマクロでは思ったように転記できません。
 自分が配列をしっかり理解していないからだとわかっているのですが・・・
 お知恵を拝借したく書込みました。

 現在、条件は"コムテック"としておりますが、"ユピテル"や"ケンウッド"など
 複数ある物を一気に転記したいです。
 条件は毎回変更するものでないです。

 Sub 簡易型を転記()
    Dim i As Long
    Dim DtR As Long, StR As Long
    Dim Tbl As Variant, MyCA As Variant, WSg As Worksheet
    Const OFR  As Long = 2
    Const RC As Long = 1

    MyCA = Array("", "", "", "C2", "D2", "E2", "F2", "G2", "H2", "I2", "", "J2", "K2")
                 'A   B  C    D     E     F     G     H     I     J    K    L    M
    With Sheets("まとめ")
        Tbl = .Range("A1:M" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    End With

    Set WSg = Sheets("カード情報")

    For i = 2 To UBound(Tbl, 1)
        If Tbl(i, 10) = "コムテック" Then　　　←ここが関係している事は理解しています。
            With WSg
                  '転記
                    DtR = .Range("C" & Rows.Count).End(xlUp).Row
                    StR = Int((DtR - OFR + 1) / RC) * RC
                    Call 転記(MyCA, Tbl, i, StR)
            End With
        End If
    Next

    MsgBox "データをコピーしました。"

 End Sub

 Sub 転記(ByVal MyCA As Variant, ByVal Tbl As Variant, ByVal MyR As 
Long, ByVal StR As Long)
    Dim i As Long
        For i = 0 To UBound(MyCA, 1)
            If MyCA(i) <> "" Then
                Sheets("カード情報").Range(MyCA(i)).Offset(StR).Value = Tbl(MyR, i + 1)
            End If
        Next
 End Sub

 どうぞ、よろしくお願いいたします。

＜使用 Excel：Microsoft365、使用 OS：Windows10 ＞

 Select Case ステートメントを使って、条件を列挙したらいかがですか？
（xyz） 2024/08/02(金) 14:51:19

■１
前のトピックがどれかわからなったので再確認になるかもしれませんが、配列に格納するのはマストなのですか？
単純に考えて

 (1) オートフィルタを設定する
 (2) J列が"コムテック,ユピテル,ケンウッド"であるものを【抽出】する
 (3) C～K列をコピーする
 (4) カード情報シートに貼付する
 (5) （必要に応じて列挿入する）

という動作で解決しそうな気がします。

■２
また、例えば↓のように「まとめ」シートに（ユニークな）項目名があったりしませんか？

    __A__  __B__  __C__  __D__  __E__ ...  __I__  ___J__  ___K__  ___L__ 
 1  項目1  項目2  項目3  項目4  項目5      項目9  項目10  項目11    －
 2
 3

その場合、【フィルタオプション】を使うというアプローチでも解決可能だとおもいます。

■３
いずれにせよ配列で出来ない話ではないですが、それがマストというわけでなければ、Excelの機能を活用したほうがよいと思います。

■４
いや、配列の勉強をしたいのだということならば

 (1)二次元配列を用意する
 (2)提案があるように条件分岐をして、条件を満たす場合だけ配列に格納する
 (3)全部格納しおわってから一気に書き出す

ということを考えればよいとおもいます。
（今の状態だと、1行ずつ書き出しているので配列を利用しているのに冗長な処理になっているとおもいます）

（もこな２） 2024/08/02(金) 18:40:07

 お手軽に修正するるなら
 If ＞Tbl(i, 10) = "コムテック" Then　　　←ここが関係している事は理解しています。
    　　　↓
 If Tbl(i, 10) = "コムテック" Or Tbl(i, 10) = "ユピテル" Or Tbl(i, 10) = "ケンウッド" Then

とか

 If IsNumeric(Application.XMatch(Tbl(i, 10),Array("コムテック", "ユピテル","ケンウッド")) Then
（マナ） 2024/08/03(土) 08:11:28

 xyz様
 もこな２様
 マナ様

 返信が遅くなり申し訳ございません。
 今後の事も考えて、配列をしっかり理解しなければ！と思っているのですが、
 理解するのに時間が掛かっている状態です…(-_-;)

 提案いただいた事を未だ実施していないので、色々試して報告させていただきます。

 まずはお礼まで
（関数がにがて） 2024/08/05(月) 08:38:26

コメント返信：

[ 一覧(最新更新順) ]

[[20240802141520]] 『複数の条件の内1つでも合致したら転記』（関数がにがて） ページの最後に飛ぶ

[[20240802141520]]　『複数の条件の内1つでも合致したら転記』（関数がにがて）　ページの最後に飛ぶ