こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルで処理を繰り返す。Excel VBAで質問です。

次のようなマクロを考えています。
“シート1”で県名をリストから選ぶと“シート2”のデータ(文字)
を“シート3”に入れていく、というものです。

“シート1”
C11セルがリストになっていて県名が選べる

“シート2”
A列に県名
1 東京都 ああああああ
2 dddd
3
4 てててててて
5 ggggggggggg
6 神奈川 つつつつつつ
7 qqqqqqqqqqqq
8 かかかかかかか
9 aaaaaaa

B列にデータが文字列であります。A列では空白になっていますが、
B列では1から5行目までデータがあります(東京都の場合)。ただ
3行目のように空白になってい場合もあります。

ここでやりたいのは、例えばシート1のリストが東京都の場合、
・シート2のA列に東京都を見つけて、
・シート2のA列が次の県名になるまでB列のデータを
・シート3のB17から下にコピーする

というものです。分からず困っていますがどなたか教えていただけないでしょうか。

※画面の設定がうまくいかないんですが、A列が県名、それ以外はB列に入っています。

投稿日時 - 2008-04-26 16:31:13

QNo.3977555

すぐに回答ほしいです

質問者が選んだベストアンサー

#1です。下記のコードをVBAのSheet1に貼り付けてください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RG1, RG2, RG3 As Range
Dim GYO As Long
Dim FL1 As Boolean
If Target.Address = "$C$11" Then
If Target = "" Then Exit Sub
Set RG1 = Target
Set RG3 = Worksheets("Sheet3").Range("B65530").End(xlUp)
If RG3.Row < 17 Then GYO = 16 - RG3.Row
For Each RG2 In Worksheets("Sheet2").Range("A1:A1000")
If RG2 = RG1 Then FL1 = True
If FL1 = True Then
If RG2 <> RG1 And RG2 <> "" Then Exit For
GYO = GYO + 1
RG3.Offset(GYO, 0) = RG2.Offset(0, 1)
End If
Next RG2
End If
End Sub

投稿日時 - 2008-04-26 20:10:25

お礼

非常にすごいもので感謝です。無駄にしたくないので、ひとつだけよろしいでしょうか。
Sheet2のA列の都道府県名で、一番下に位置する都道府県が選択された場合、処理がとまらず、ずっと探し続けているようです。
自分では処置方法が分からず、ここまで教えていただけて恐縮ですがmshr1962さんに伺う以外ないと思い、またお尋ねしたいと思っています。

投稿日時 - 2008-04-26 22:27:03

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.4

こんばんは。

#2さんのマクロを読みながら、
>一番下に位置する都道府県が選択された場合、処理がとまらず、ずっと探し続けているようです。

というよりも、ある程度、マクロを予想した表が出来上がっていれば、そのようなことがなかったと思います。

本来は、空白はあってもなくても、都道府県ひとつに対して、固定の行数を決めるべきだったと思います。例えば、5行とか、そういう表示フォームができていればよかったのですね。

#2さんの処理を途中で終わらせるために、簡単な方法としては、
B列の最終行の次の行のA列に、何か、終了のための関係のない文字をひとつ入れてあげればよいです。

例:
沖縄   ccc
     ddd
     eee
     fff
*     ←例えば、最後の行に、このようにすれば終わります。
-----------------------------

私も作ってみました。ダイレクトで、Sheet2のA列を探します。
私の場合は、そのままでも可能です。

----------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i As Variant
  Dim j As Long, k As Long
  Dim Sh2 As Worksheet
  Dim Sh3 As Worksheet

  Set Sh2 = Worksheets("Sheet2")
  Set Sh3 = Worksheets("Sheet3")

  If Target.Count > 1 Then Exit Sub
  If Target.Address(0, 0) <> "C11" Then Exit Sub
  If Target.Value = "" Then Exit Sub
  With Sh2
    i = Application.Match(Target.Value, .Columns(1), 0)
    If Not IsError(i) Then
      j = .Cells(i, 1).End(xlDown).Row
      k = Sh3.Range("B65536").End(xlUp).Row
      If k < 17 Then k = 17 Else k = k + 1
      If j < 65535 Then
        .Range(.Cells(i, 2), .Cells(j - 1, 2)).Copy Sh3.Cells(k, 2)
      Else
        j = .Cells(65536, 2).End(xlUp).Row
        .Range(.Cells(i, 2), .Cells(j, 2)).Copy Sh3.Cells(k, 2)
      End If
    Else
     MsgBox "『" & Target.Value & "』は、リストから見つかりません。", 48
    End If
  End With
  Set Sh2 = Nothing
  Set Sh3 = Nothing
End Sub

投稿日時 - 2008-04-27 00:31:49

お礼

Wendy02さんおはようございます。
現象はそういうことなんですね。まったく意識していませんでした。
ところでWendy02さんのコードですが、試させていただきました。
すごいものでした。本当にありがとうございます。解決に導いていただいて心苦しいのですがmshr1962さんには辛抱強くお付き合いいただいた経緯があり、今回次点ということでお許しいただけますでしょうか。申し訳ありません。本当に助かります。

投稿日時 - 2008-04-27 10:39:21

ANo.3

既に近いところまで回答は出ているようですが、こういう課題を考えるとき、まず日本語文章でもって整理することをお勧めします。人間がコンピュターを使わずやったらどうなるかを書き出してみる。そして何をコード上で作れれば、通しで課題が実現するのか。そしてこの質問では、それは
(1)Sheet1のC11で県名が選択されたら県名の値をとる。こういう値  は一旦変数に代入するものです。
  ここでリストの「コンボボックスをクリックしたら反応」とした  いが、入力規則では、それが出来ないので、セルの値のChangeイ  ベントというもので捉まえる。この点は経験から。
(2)選択された県名でSheet2のA列の県名のあるセルを探索する
  -->色々なやり方があって、迷うという点では難しいが、私は
  エクセル関数のMATCH関数がVBAでも使えるので、それを使うのを  やってみる。
(3)見つかった行の次の行から、下に空白で無い行までの各行につ   いて
   列データ(=項目、下記例では「内容」)をSheet3に代入する。
   Sheet2から採ってくる行数は不定らしいが、数行だから、1行   1行聞いて行けばよいだろう。
(4)Sheet3はSheet2で検索した結果を(A)累積するのか(B)定位置セル(B17からの数行)に(指定県が変われば)上書きするのか。(A)か(B)か質問でははっきりしない。
 以上でサブの課題に分けられる。
こういう作業の説明も、各部分のコードを検討した様子も質問では伺えず、回答者に作ってくださいと丸投げになっている。
(定則)課題は分割して当たれ。
ーー
実例説明すると
Sheet1
入力規則で
東京都
神奈川県
千葉県
を設定
ーーー
Sheet2に
A1:B17に
県名  内容
東京都a
ーーーb
ーーーc
ーーーd
ーーーe
ーーーf
千葉県s
ーーーg
ーーーf
ーーーg
ーーーh
神奈川県c
ーーーs
ーーーd
ーーーf
ーーーg
(ーーーは空白セルのつもり。)のデータがあるとする。
ーー
Sheet1のシートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
x = Worksheets("Sheet1").Range("C11")
MsgBox x
y = WorksheetFunction.Match(x, Worksheets("Sheet2").Range("A1:A100"), 0)
MsgBox y
'--
j = 17
Worksheets("Sheet3").Cells(j, "C") = Worksheets("Sheet2").Cells(y, "B")
y = y + 1
j = j + 1 '以上県名のある行の内容を移す
While Worksheets("Sheet2").Cells(y, "A") = ""
MsgBox Worksheets("Sheet2").Cells(y, "B")
Worksheets("Sheet3").Cells(j, "C") = Worksheets("Sheet2").Cells(y, "B")
y = y + 1
j = j + 1 '以上県の名の無い行の内容を移す
Wend
End Sub
を作る。
ーーー
操作と結果
Sheet1のC11の選択を、千葉県を選択すると、千葉県のメッセージが出て
Sheet2の千葉県のある行番号8がメッセージで出る。
そしてSheet3のB17から下に
s
g
f
g
h
ーー
Msgboxは確認テスト用なので、用済み段階以後は削除
B列の内容に空白セルが有り得て、Sheet3にはその後の行で詰めるなら、IF文でB列セルが空白か聞いて、空白なら代入をスキップしてください。

投稿日時 - 2008-04-26 20:11:10

お礼

ご回答ありがとうございます。今mshr1962さんのコードためさせていただいており、少し時間がかかるかもしれませんがお許しください。

投稿日時 - 2008-04-26 22:29:46

ANo.1

一例です。
Sheet1のA1からセルがブランクになるまで都道府県名をチェック
Sheet2で同じ値を見つけて、B列のその行をSheet3にセット
Sheet2で次の値になるまで、B列のその行をSheet3にセットの繰り返し
Sheet1のセルがブランクになると終了

Sub BCCOPY()
Dim RG1, RG2 As Range
Dim GYO As Long
Dim FL1 As Boolean
GYO = 16
For Each RG1 In Worksheets("Sheet1").Range("A1:A48")
If RG1 = "" Then GoTo TONEXT
For Each RG2 In Worksheets("Sheet2").Range("A1:A1000")
If RG2 = RG1 Then FL1 = True
If FL1 = True Then
If RG2 <> RG1 And RG2 <> "" Then Exit For
GYO = GYO + 1
Worksheets("Sheet3").Range("B" & GYO) = RG2.Offset(0, 1)
End If
Next RG2
TONEXT: FL1 = False
Next RG1
End Sub

投稿日時 - 2008-04-26 17:46:56

お礼

mshr1962さんこんばんは。
Sheet1のA1からセルがブランクになるまで都道府県名をチェック
というようにご提示いただいたのですが、私の質問文が言葉足らずでした。Sheet1はC11が入力規則のリストで作ってあり、そこで都道府県名がひとつ選べるようになっています。
あくまで参考サンプルで、というご提示であったら誤解をし、申し訳ありません。
できたら
Sheet1のC11の都道府県名をチェック
というような形でお教えいただけとありがたいです。

投稿日時 - 2008-04-26 19:00:29

あなたにオススメの質問