Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


31095 / 76732 ←次へ | 前へ→

【50892】Re:セルの中身を振り分ける
発言  ichinose  - 07/8/21(火) 21:51 -

引用なし
パスワード
   ▼33 さん:
こんばんは。


>A      B
>1,000  甲 乙 丙
>1,500  甲 丙
>2,000  乙
>2,500  乙
>3,000  丙
>   ↓
>1,000  甲 乙 丙  1,000  甲 乙 丙  1,000  甲 乙 丙
>1,500  甲 丙     2,000  乙       3,000  丙
>               2,500  乙

入力データと出力データの記述はまずまずだと思いますが・・・。

Excelを使って、このようなデータベースもどきの処理を行う場合は、
先頭行には項目名を入れる癖を付けた方が良いですよ。
入力セル範囲を取得するのも楽だし、フィルタ処理なども行えますから・・・。


例えば、「Sheet1」というシートが入力データシートだとすると、
      A     B
 1   数値   シート名
 2   1,000   甲 乙 丙
 3   1,500   甲 丙
 4   2,000   乙
 5   2,500   乙
 6   3,000   丙

というようにここでは、1行目の「数値」、「シート名」を項目名にしました。

次いで、甲 乙 丙 というシートには、項目名だけ設定しておきます。

      A     B
 1   数値   シート名

シート「甲」、「乙」、「丙」いずれも上記のように項目名のみ設定しておきます。

 
標準モジュールに
'=========================================================
Sub test()
  Dim シート名 As Variant
  Dim rng As Range
  Dim g0 As Long
  Dim orw As Long
  シート名 = Array("甲", "乙", "丙")
  With Worksheets("sheet1")
    Set rng = .Range("a2", .Cells(.Rows.Count, 1).End(xlUp))
    End With
  If rng.Row > 1 Then
    For g0 = 1 To rng.Count
     For g1 = LBound(シート名) To UBound(シート名)
       If InStr(rng(g0, 2), シート名(g1)) > 0 Then
        With Worksheets(シート名(g1))
          orw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
          .Range(.Cells(orw, 1), .Cells(orw, 2)).Value = rng(g0).Resize(, 2).Value
          End With
        End If
       Next
     Next
    End If
End Sub

新規ブックに上記のようなテストデータを作成してtestを実行して見てください。

33 さんが提示されたような出力を振り分けます(勿論、項目名付きで)。

試してみてください。


それから

>If cell = 甲 then ですといずれも引っかかりませんでした。

このような記述をされると、大枠でこのようなコーディングをされているのか?
実際に↑そのもののコードを書かれているのかこの投稿を見ている方には
わかりません。もうすこし、全体のコードを掲載するようにしてください。

1 hits

【50888】セルの中身を振り分ける 33 07/8/21(火) 20:47 質問
【50892】Re:セルの中身を振り分ける ichinose 07/8/21(火) 21:51 発言
【50893】Re:セルの中身を振り分ける 訂正 ichinose 07/8/21(火) 21:54 発言
【50919】Re:セルの中身を振り分ける 訂正 33 07/8/22(水) 13:02 お礼

31095 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free