Ｐａｇｅ 582 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼列ごとのデータ抽出 コタツみかん 03/1/20(月) 15:13 ┗Re:列ごとのデータ抽出 Jaka 03/1/20(月) 16:39 ┗Re:列ごとのデータ抽出 コタツみかん 03/1/20(月) 17:30 ┗Re:列ごとのデータ抽出 Jaka 03/1/21(火) 11:10 ┗Re:列ごとのデータ抽出 コタツみかん 03/1/22(水) 10:05 ─────────────────────────────────────── ■題名 ： 列ごとのデータ抽出 ■名前 ： コタツみかん ■日付 ： 03/1/20(月) 15:13 -------------------------------------------------------------------------
| ＶＢＡ初心者です。 今回、列ごとのデータの中から、条件にあうデータを抽出して、（同じシート内の） 別の場所へ表示するマクロを作りたかったのですが、このままだと、列の数分マクロを 作成しており、とても不便です。 どのように改良すれば、よろしいでしょうか？ 現在は、条件に一致するデータの個数をまずcountifで求めて、マクロでその個数分を コピーするという手法をとっています。 【元のデータ】 B列 C列 D列 E列 項目名 3001 3002 3003 3004 データ Ａ Ｂ Ａ Ａ Ａ Ａ Ａ Ｃ Ａ Ｓ Ｄ Ｆ 【抽出の条件】 項目名 3001 3002 3003 3004 条件 Ａ Ａ Ｄ Ｇ 数式 3 1 2 【取得したい結果】 項目名 3001 3002 3003 3004 Ａ Ａ Ｄ Ａ Ｄ Ａ 作成したマクロ Sub B列値のコピー() Dim X As Integer 'Xはコピーする回数 X = 0 Range("B26:K30").ClearContents '以前の値を消す Range("B18").Select If Range("B19").Value <> "" Then ActiveCell.Select Selection.Copy Range("B26").Select ActiveSheet.Paste Do Until X = Range("B19").Value ActiveSheet.Paste ActiveCell.Offset(1, 0).Select X = X + 1 Loop Application.CutCopyMode = False End If End Sub この中で、B18が【抽出の条件】の3001の条件「A」です。 これをB26からX回分コピーさせています。 よろしくお願いします。 |
| こんにちは。 シート関係と行等が良くわかんないんですけど。 例えばSheet1のB18の「A」という文字を、B2〜B17に何個入っているか数えて、あった分だけSheet2のB2からBnまで繰り返す手書き出す。と言う事でしょうか？ C18、D18、E18も同じように（Sheet2に項目名は、当然入れて） Sheet1 【元のデータ】 B列 C列 D列 E列 1 項目名 3001 3002 3003 3004 2 データ Ａ Ｂ Ａ Ａ 3 Ａ Ａ Ａ Ｃ 4 Ａ Ｓ Ｄ Ｆ 5 ・ ・【抽出の条件】 ・ ・ 項目名 3001 3002 3003 3004 18 条件 Ａ Ａ Ｄ Ｇ 19 数式 3 1 2 Sheet2 【取得したい結果】 1 項目名 3001 3002 3003 3004 2 Ａ Ａ Ｄ 3 Ａ Ｄ 4 Ａ |
| Jaka さん、さっそくのお返事ありがとうございます。 まさに、ご指摘の通りです。 よろしくお願いします。 >こんにちは。 >シート関係と行等が良くわかんないんですけど。 >例えばSheet1のB18の「A」という文字を、B2〜B17に何個入っているか数えて、あった分だけSheet2のB2からBnまで繰り返す手書き出す。と言う事でしょうか？ >C18、D18、E18も同じように（Sheet2に項目名は、当然入れて） |
| こんにちは。 私の言った通りだと、提示されたデータのＤの個数が違うみたいですけど．．．。今気づいた。 取りあえず私の言った通りだと、こんな感じです。 Sub wowo() Dim DCnt As Long, i As Long, ii As Long Sheets("Sheet2").Range("A1:E1").Value = Range("A1:E1").Value For i = 2 To 5 DCnt = Application.CountIf(Range(Cells(2, i), Cells(17, i)), Cells(18, i).Value) If DCnt > 0 Then For ii = 1 To DCnt Sheets("Sheet2").Cells(ii + 1, i).Value = Cells(18, i).Value Next End If Next End Sub |
| Jaka さん、早速の解答ありがとうございます。 >こんにちは。 >私の言った通りだと、提示されたデータのＤの個数が違うみたいですけど ↑ 大変失礼しました。違っておりました。 (>_<) また、お伺いすることもあるかと思います。 その時にはよろしくお願いします。 |