1452477297 【再度】【エクセルVBA】文字列を読み取ってペーストしたい



シートが2つあります「★」「場所」

★シートのA列にタイトル、K列に管理番号が下に並びます」。特定の条件(※)を満たすものをコピーし、場所シートにペーストします。


※特定の条件
★シートK列内の管理番号は151214000AJKなど、先頭の9ケタが数字です。それが160108以降のものを抽出し、その数字を降順にしたあとに残りの文字もくっつけなおして場所シートにはりつけます。半角ですが、英大文字と小文字は区別します。タイトル最後に「/」があるものもまれにあり、除いて考えます。その2文字は同じ値が場所シートのA列のA、C,E,G,I列の、ともに199行目まで入っていることがあり、これと一致する場合だけは除き、一致しないタイトルのみ(160108以降)を抽出し、

場所シートのB200から下に、D200からはB列の商品番号に対応するタイトルをペーストします。

注意点
・★シートのK列管理番号が空白、もしくは7桁が数字となっていないものは無視します。
・タイトルの後の2文字は1文字の時有(mやe、★等)記号使用もあり(-等)
最後のスラッシュを除き、最大半角2文字分までです。

回答の条件
  • 1人1回まで
  • 13歳以上
  • 登録:2016/01/11 10:54:57
  • 終了:2016/01/12 12:11:25

ベストアンサー

id:a-kuma3 No.1

a-kuma3回答回数4412ベストアンサー獲得回数18032016/01/11 17:32:21

ポイント300pt

以下のコードを標準モジュールに貼り付けて、copy_item_data サブルーチンを実行してください。
アクティブなシートを対象にして、該当するデータを "場所" シートに複写します。

Const MAX_ROW = 10000
Const BASE_ITEM_NUMBER = 160108000


Function is_blank_cell(c)
    is_blank_cell = IsEmpty(c) Or c.Value = ""
End Function


Function is_need_copy(item_number, c_name, re_mark, mark_map)
    is_need_copy = True
    If item_number < BASE_ITEM_NUMBER Then
        is_need_copy = False
    Else
        Set remat = re_mark.Execute(c_name.Value)
        If remat.Count > 0 Then
            mark = remat(0).Submatches(0)
            mark1 = Right(mark, 1)
            If mark_map.Exists(mark) Then
                is_need_copy = False
            ElseIf mark_map.Exists(mark1) Then
                is_need_copy = False
            End If
        End If
    End If
End Function


Sub copy_item_data()
    Set dest_sheet = Sheets("場所")

    Set re_mark = CreateObject("VBScript.RegExp")
    re_mark.Pattern = "(..)/?$"

    Set mark_map = CreateObject("Scripting.Dictionary")

    ' A, C, E, G, I 列の文字を読み取る
    For r = 2 To 199
        For c = 1 To 9 Step 2   ' A, C, E, G, I
            v = CStr(dest_sheet.Cells(r, c).Value)      ' ★ここを変えました
            If v <> "" And Not mark_map.Exists(v) Then
                mark_map.Add v, v
            End If
        Next
        DoEvents
    Next

    dest_r = 200
    r = 2
    blank_count = 0
    Do Until blank_count = 20   ' 空白行が20行続いたら打ち切り
        Set c_num = Cells(r, 11)        ' K 列
        Set c_name = Cells(r, 1)        ' A 列
        If is_blank_cell(c_num) Then
            blank_count = blank_count + 1
        Else
            blank_count = 0
            item_number = Val(Left(c_num.Value, 9))
            If is_need_copy(item_number, c_name, re_mark, mark_map) Then
                c_num.Copy dest_sheet.Cells(dest_r, 4)              ' 商品番号
                c_name.Copy dest_sheet.Cells(dest_r, 2)             ' 商品名
                dest_sheet.Cells(dest_r, 6).Value = item_number     ' 商品番号(上9ケタ)
                dest_r = dest_r + 1
            End If
        End If
        DoEvents
        r = r + 1
        If r > MAX_ROW Then     ' 念のため
            Exit Do
        End If
    Loop

    ' 商品番号の上9ケタの降順で並べ替え
    dest_sheet.Range(dest_sheet.Cells(200, 1), dest_sheet.Cells(dest_r, 6)).Sort Key1:=dest_sheet.Range("f200"), Order1:=xlDescending

    Set re_mark = Nothing
    Set mark_map = Nothing
End Sub

並べ替えに使うために、「場所」シートの F列に商品番号の頭9ケタの数字を入れてます。
入れたままにしてますが、邪魔なようでしたら並べ替えの後に消す処理を入れてください。

    ' 商品番号の上9ケタの降順で並べ替え
    dest_sheet.Range(dest_sheet.Cells(200, 1), dest_sheet.Cells(dest_r, 6)).Sort Key1:=dest_sheet.Range("f200"), Order1:=xlDescending

    ' 商品番号の上9ケタを消す
    dest_sheet.Range(dest_sheet.Cells(200, 6), dest_sheet.Cells(dest_r, 6)).ClearContents



追記です。

りんご6/
とか
みかん/14を

B200以上のところに書き込んでしまいます。

「場所」シートの 199行目までに書かれている商品名の末尾が数値になっているときの考慮が抜けていました。
先に書いた回答のコードを修正しましたので、確認してみてください。

id:naranara19

ありがとうございます!!

14とか6の保管場所があるものを拾ってしまうみたいです。

りんご6/
とか
みかん/14を

B200以上のところに書き込んでしまいます。
その対応をお願いできますでしょうか?
お手数をおかけいたします。

2016/01/11 18:38:48
id:naranara19

完璧でした。長々とお付き合いいただき、誠にありがとうございました!心より感謝しております。

2016/01/12 12:11:01
  • id:a-kuma3
    こういうことでしょうか。
    ・管理番号の先頭9ケタが数値で、160108000以降のものを抽出
     ・管理番号の先頭9ケタが数値でないものは対象外
    ・商品名の末尾にはマークが入っていることがある
     ・商品名の末尾につく "/" は無視する
     ・商品名の末尾1~2バイトがマーク(ないこともある)
     ・マークが「場所」シートの A、C、E、G、I 列の 1~199行の範囲に入力されている場合には商品名抽出の対象外とする
    ・場所シートで並べ替えるときは、管理番号ではなく管理番号の先頭9ケタで並べ替え

    で、いくつか質問。
    >先頭の9ケタが数字です。それが160108以降のものを抽出し
     前の質問と同じで、160108000 ではなく?
    >★シートのK列管理番号が空白、もしくは7桁が数字となっていないものは無視します。
     7ケタですか? 9ケタではなく?
    >タイトルの後の2文字は1文字の時有(mやe、★等)記号使用もあり(-等)最後のスラッシュを除き、最大半角2文字分までです。
     半角1文字の場合もあるんですね。
     例えば、商品名が「みかん-m/」だったら、末尾の "/" を無視して、"m" か "-m" が場所シートに記載されている可能性があるということですね。
  • id:naranara19
    すみません。仕様がややこしくて。

    質問の前はその通りでございます。

    で、いくつか質問。
    >先頭の9ケタが数字です。それが160108以降のものを抽出し
     前の質問と同じで、160108000 ではなく?

    →おっしゃるとおり、160108000が正しいです。失礼しました。

    >★シートのK列管理番号が空白、もしくは7桁が数字となっていないものは無視します。
     7ケタですか? 9ケタではなく?

    →おっしゃるとおり9ケタ数字でお願いします(半角です)

    >タイトルの後の2文字は1文字の時有(mやe、★等)記号使用もあり(-等)最後のスラッシュを除き、最大半角2文字分までです。
     半角1文字の場合もあるんですね。
     例えば、商品名が「みかん-m/」だったら、末尾の "/" を無視して、"m" か "-m" が場所シートに記載されている可能性があるということですね。

    →はい。その通りでございます。/を除いてから最大半角2文字分となります。-mは実際にはないので、該当しない場合は無視にてお願いいたします。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません