Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1297 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【75209】複数の範囲(膨大)を、変数に取り込む 初心者Ｍ 14/1/8(水) 12:03 質問[未読]
【75210】Re:複数の範囲(膨大)を、変数に取り込む kanabun 14/1/8(水) 13:18 発言[未読]
【75211】Re:複数の範囲(膨大)を、変数に取り込む 初心者Ｍ 14/1/8(水) 13:59 質問[未読]
【75212】Re:複数の範囲(膨大)を、変数に取り込む kanabun 14/1/8(水) 14:35 発言[未読]
【75213】Re:複数の範囲(膨大)を、変数に取り込む 初心者Ｍ 14/1/8(水) 15:00 お礼[未読]
【75214】Re:複数の範囲(膨大)を、変数に取り込む kanabun 14/1/8(水) 16:57 発言[未読]
【75215】Re:複数の範囲(膨大)を、変数に取り込む kanabun 14/1/8(水) 17:06 発言[未読]
【75216】Re:複数の範囲(膨大)を、変数に取り込む 初心者Ｍ 14/1/8(水) 17:22 発言[未読]
【75217】Re:複数の範囲(膨大)を、変数に取り込む kanabun 14/1/8(水) 17:33 発言[未読]
【75218】Re:複数の範囲(膨大)を、変数に取り込む 初心者Ｍ 14/1/8(水) 17:51 発言[未読]
【75219】Re:複数の範囲(膨大)を、変数に取り込む kanabun 14/1/8(水) 18:01 発言[未読]
【75220】Re:複数の範囲(膨大)を、変数に取り込む 初心者Ｍ 14/1/8(水) 18:04 お礼[未読]
【75209】複数の範囲(膨大)を、変数に取り込む
質問  初心者Ｍ  - 14/1/8(水) 12:03 -
引用なし
パスワード
   昨日「複数の異なる値を取り込んで、順に処理したいです」という質問をさせていただいた者です。その節はお世話になりました。
この際、回答者の方に作って頂いたコードを自分の手元の表に応用する方法で、また悩んでいます。

手元の表は(違う形式もありますが)縦にはセルe8からe16まで、7個空けてe24からe32まで、とこれが下に25回並んでおり、横方向にはe8から2個空けてh8からh16まで、また2個空けてk8からk16までという具合に、こちらは27回並んでいます。

これを、昨日の回答で頂いた以下のコードの「ｒ」に入れたいのですが、どのような方法が良いか、ご指導いただけませんでしょうか。
自分では(E8:E16,E24:E32,E40:E48,E56:E64,E72:E80,E88:E96,E104:E112,E120:E128)と羅列するような方法しか思いつきませんでした。

よろしくお願いいたします。


Sub test()

　　Dim a, b As Variant
　　Dim i As Long
　　Dim r As Range
　　Dim dic As Object

　　Set dic = CreateObject("Scripting.Dictionary")
　
　　Set r = Range("e8", Range("e8").End(xlDown))
　　
　　a = r.Value　　　　　　
　　b = r.Offset(, -2).Value
　　
　　For i = 1 To 9 'UBound(b)
　　　　If Not dic.Exists(b(i, 1)) Then
　　　　　　dic(b(i, 1)) = a(i, 1)
　　　　ElseIf dic(b(i, 1)) < a(i, 1) Then
　　　　　　dic(b(i, 1)) = a(i, 1)
　　　　End If
　　Next
　　
　　'縦２５回
　　'横２７回
　　
　　For i = 1 To 9 'UBound(b)
　　　　a(i, 1) = dic(b(i, 1))
　　Next
　　r.Value = a
　
End Sub
【75210】Re:複数の範囲(膨大)を、変数に取り込む
発言  kanabun  - 14/1/8(水) 13:18 -
引用なし
パスワード
   ▼初心者Ｍ さん：

>手元の表は...縦にはセルe8からe16まで、7個空けてe24からe32まで、とこれが下に25回並んでおり、横方向にはe8から2個空けてh8からh16まで、また2個空けてk8からk16までという具合に、こちらは27回並んでいます。

う〜ん、それだけたくさんのエリアだと、配列化はしにくいですね。
ちょっと時間はかかるけど、セルに直接アクセスしましょう。
最初のセルが[E8]で、[D8]に数値（部数）が書いてあると仮定します。

>　　'縦２５回
>　　'横２７回

ですから、縦方向へは 16セルづつジャンプすると、各エリア(連続範囲のこと)の
先頭セルですね。
列方向は 3セルづつジャンプしながら、27回。
こうして各エリアの先頭セルが求まりますから、
先頭セルから行方向に9セル Resizeしたセル範囲が対象エリアです。

Sub test3()
　　Dim n As Long
　　Dim y As Long, x As Long
　　Dim ss As String
　　Dim c As Range
　　Const Y0 = 8, YY = 25, Ystp = 16 '縦方向 最初の行番、繰り返し回数,Step
　　Const X0 = 5, XX = 27, Xstp = 3 '列方向 最初の列番、繰り返し回数,Step
　　Dim dic As Object
　　Set dic = CreateObject("Scripting.Dictionary")
　　
　　For x = X0 To X0 + (XX - 1) * Xstp Step Xstp
　　　For y = Y0 To Y0 + (YY - 1) * Ystp Step Ystp
　　　　　For Each c In Cells(y, x).Resize(9)
　　　　　　ss = c.Value
　　　　　　If Len(ss) > 0 Then
　　　　　　　n = c.Offset(, -1).Value
　　　　　　　If Not dic.Exists(ss) Then
　　　　　　　　　dic(ss) = n
　　　　　　　ElseIf dic(ss) < n Then
　　　　　　　　　dic(ss) = n
　　　　　　　End If
　　　　　　End If
　　　　　Next
　　　　Next
　　Next
　　For x = X0 To X0 + (XX - 1) * Xstp Step Xstp
　　　For y = Y0 To Y0 + (YY - 1) * Ystp Step Ystp
　　　　　For Each c In Cells(y, x).Resize(9)
　　　　　　ss = c.Value
　　　　　　If Len(ss) > 0 Then
　　　　　　　　c.Offset(, -1).Value = dic(ss)
　　　　　　End If
　　　　　Next
　　　　Next
　　Next
　　
End Sub
【75211】Re:複数の範囲(膨大)を、変数に取り込む
質問  初心者Ｍ  - 14/1/8(水) 13:59 -
引用なし
パスワード
   kanabun様

昨日に引き続き、誠に有り難うございます。
作っていただいた物を拝見するたび、高度かつ難解なので、自分のやろうとしていたことは、かなり分不相応なことだったのだと思い知らされます。

丸々聞いてしまうのはルール違反かと思うのですが、ちょっと私では理解できないので、以下もお教えいただけると光栄です。

実は、見たいセル(Ａ、イなどの記号があるセル)はＤ８でなく、一個隣のＣ８にあります(すみません、昨日とは違うファイルでやることになったのです)。

この場合、どこをいじれば良いでしょうか？
ちなみに昨日の場合では
　
　　a = r.Value　　　　　　
　　b = r.Offset(, -1).Value

の「-1」を「-2」にしたら上手くいったのですが、今回は複雑で、なかなか理解が追いつきません。

ちなみに、先ほどのコードをそのまま手元の表で動かしたところ、ｅ８のすぐ隣の行に全て「０」が記入されました。

大変恐縮ですが、何卒よろしくお願いいたします。
【75212】Re:複数の範囲(膨大)を、変数に取り込む
発言  kanabun  - 14/1/8(水) 14:35 -
引用なし
パスワード
   ▼初心者Ｍ さん：
>
>実は、見たいセル(Ａ、イなどの記号があるセル)はＤ８でなく、一個隣のＣ８にあります(すみません、昨日とは違うファイルでやることになったのです)。
>
>この場合、どこをいじれば良いでしょうか？

>　　b = r.Offset(, -1).Value
>
>の「-1」を「-2」にしたら上手くいったのですが、

今回も「-1」を「-2」にすればいいですよ

　　For x = X0 To X0 + (XX - 1) * Xstp Step Xstp
　　　For y = Y0 To Y0 + (YY - 1) * Ystp Step Ystp
　　　　　For Each c In Cells(y, x).Resize(9)
　　　　　　ss = c.Value
　　　　　　If Len(ss) > 0 Then
　　　　　　　n = c.Offset(, -1).Value　 '◆ココと
　　　　　　　If Not dic.Exists(ss) Then
　　　　　　　　　dic(ss) = n
　　　　　　　ElseIf dic(ss) < n Then
　　　　　　　　　dic(ss) = n
　　　　　　　End If
　　　　　　End If
　　　　　Next
　　　　Next
　　Next
　　For x = X0 To X0 + (XX - 1) * Xstp Step Xstp
　　　For y = Y0 To Y0 + (YY - 1) * Ystp Step Ystp
　　　　　For Each c In Cells(y, x).Resize(9)
　　　　　　ss = c.Value
　　　　　　If Len(ss) > 0 Then
　　　　　　　　c.Offset(, -1).Value = dic(ss) '◆ココ
　　　　　　End If
　　　　　Next
　　　　Next
　　Next
【75213】Re:複数の範囲(膨大)を、変数に取り込む
お礼  初心者Ｍ  - 14/1/8(水) 15:00 -
引用なし
パスワード
   kanabun様

本当に有り難うございました。
記号が不定のことが多い場合、

Dim n As Long

をstringかvariantに変えれば上手くいきますでしょうか。

実はちょっと試したところ、C8の行の記号が勝手に書き換わるという現象が起き、？？？という状態です。書き換わった後は、上手い具合に最大値に揃っているようです。

あまり頼りっぱなしもよくないと思うのですが、もし、万が一、心とお時間に余裕が有れば、またお教えいただけると光栄です。

有り難うございます。
【75214】Re:複数の範囲(膨大)を、変数に取り込む
発言  kanabun  - 14/1/8(水) 16:57 -
引用なし
パスワード
   ▼初心者Ｍ さん：

>記号が不定のことが多い場合、
>
>Dim n As Long
>
>をstringかvariantに変えれば上手くいきますでしょうか。
>
>実はちょっと試したところ、C8の行の記号が勝手に書き換わるという現象が起き、
> ？？？という状態です。

そんなことしてもダメです。
全部のセルの記号に重複がなくユニークだったとしても、セル数 n は6075種類
ですから、
>Dim n As Long
でいいのです（最大6075ですからInteger型でもいいのですが、Long型が最善です）

こちらで動作を確かめるために、適当なデータをシート上に作成するために書いた
コードがありますから、そちらでも、新規シートをアクティブにして、↓を走らせて
ダミーデータを作成したものに対して、
Sub test3() を走らせて、どうなるか、テストしてみてください。


Sub test31データ埋め込み()
　　Dim j As Long
　　Dim y As Long, x As Long
　　Dim Label As String
　　Dim c As Range
　　Dim r As Range
　　Const Y0 = 8, YY = 25, Ystp = 16 '縦方向 最初の行、繰り返し回数,Step
　　Const X0 = 5, XX = 27, Xstp = 3 '列方向 最初の列、繰り返し回数,Step
　　
　　Const Lo = 1, Hi = 2000
　　Randomize
　　
　　j = 0
　　Cells.Interior.ColorIndex = xlNone
　　For x = X0 To X0 + (XX - 1) * Xstp Step Xstp
　　　For y = Y0 To Y0 + (YY - 1) * Ystp Step Ystp
　　　　　Set r = Cells(y, x).Resize(9)
　　　　　r.Interior.Color = vbCyan
　　　　　For Each c In r
　　　　　　　c(1, -1).Value = Int(Hi * Rnd() + Lo)
　　　　　　　j = j + 1: If j > 14 Then j = 1
　　　　　　　c.Value = Mid$("ABCDABCDKLMXYZ", j, 1)
　　　　　Next
　　　　Next
　　Next
End Sub
【75215】Re:複数の範囲(膨大)を、変数に取り込む
発言  kanabun  - 14/1/8(水) 17:06 -
引用なし
パスワード
   ▼初心者Ｍ さん：

あ、ごめんなさい。別のこと考えてました。
>全部のセルの記号に重複がなくユニークだったとしても、セル数 n は6075種類
>ですから、
>>Dim n As Long
>でいいのです（最大6075ですからInteger型でもいいのですが、Long型が最善です）
↑ここまでの文章は、ウソです。無視してください m(_ _)m

[C8] は部数？(数値)が書いてあるんではないですか？
数値以外の記号のこともあるんですか？
【75216】Re:複数の範囲(膨大)を、変数に取り込む
発言  初心者Ｍ  - 14/1/8(水) 17:22 -
引用なし
パスワード
   ▼kanabun様


>[C8] は部数？(数値)が書いてあるんではないですか？
>数値以外の記号のこともあるんですか？

大っっ変申し訳ございません。根本的に私の説明がマズかったです。昨日とファイルが変わったのですが、配列の取り込みしか頭に無かったのできちんと説明をしていませんでした。

C8の縦行に(9行の中に、データは飛び飛びで入ります。1列だけのことも多いです)１，２などの数字(時には記号)が入り、E8の縦行に「７６００」などの数値が入ります。

(私の仕事ではないのですが)この表では、数の近いものを人間の目で見て照らし合わせて、近くにある最適なものと同じ記号で付け合せをするんです。その後、手動でその中の一番大きな数字の物に入力し直すという作業をするのですが、これが見ていて大変そうだったので、なんとか自動化して楽にさせてあげたいという気持ちから、密かにやっていることでした。

もっと言うと、Ｄ８の列には「２」や「４」といった数字が入ることがあり、その場合はE8の数値がそれをかけた数字になります。
これは、外注先の工場に送る仕様書の作成作業です。

データが数値であれば、longが最善なのはなんとか理解できます。
【75217】Re:複数の範囲(膨大)を、変数に取り込む
発言  kanabun  - 14/1/8(水) 17:33 -
引用なし
パスワード
   ▼初心者Ｍ さん：

>大っっ変申し訳ございません。根本的に私の説明がマズかったです。昨日とファイルが変わったのですが、配列の取り込みしか頭に無かったのできちんと説明をしていませんでした。
>
>C8の縦行に(9行の中に、データは飛び飛びで入ります。1列だけのことも多いです)１，２などの数字(時には記号)が入り、E8の縦行に「７６００」などの数値が入ります。

>
>もっと言うと、Ｄ８の列には「２」や「４」といった数字が入ることがあり、その場合はE8の数値がそれをかけた数字になります。
>これは、外注先の工場に送る仕様書の作成作業です。

では、列番号付きで、C,D,E列の最初のブロックだけでも、サンプルデータを
見せてください。
【75218】Re:複数の範囲(膨大)を、変数に取り込む
発言  初心者Ｍ  - 14/1/8(水) 17:51 -
引用なし
パスワード
   kanabun様

大変申し訳ございませんでした。
このような感じになります。先ほど勘違いしていましたが、DやGに入る「２」や「４」の数字は、かけるのでなく割るのに使います。ここの処理までは、個人的には諦めていました。


　　Ｃ　Ｄ　　Ｅ　Ｆ　Ｇ　Ｈ
８

９　15　　　2000　15　　　1800

10

11

12　17　　　5900　17　２　11800


これで伝わりますでしょうか。
ヒントだけでもいただければ大変嬉しいです。

どうぞよろしくお願いいたします。
【75219】Re:複数の範囲(膨大)を、変数に取り込む
発言  kanabun  - 14/1/8(水) 18:01 -
引用なし
パスワード
   ▼初心者Ｍ さん：
> DやGに入る「２」や「４」の数字は、かけるのでなく割るのに使います。ここの処理までは、個人的には諦めていました。
>
>
>　　Ｃ　Ｄ　　Ｅ　Ｆ　Ｇ　Ｈ
>８
>
>９　15　　　2000　15　　　1800
>
>10
>
>11
>
>12　17　　　5900　17　２　11800
>
>
とりあえず、3列のうち、中央の列のことは無視して、C列、F列に何か記号が
入っていれば、その記号別に第3列(E列、H列...)の数値の最大値を振り当てる
というコードです。
つまり、Sub test3() を3か所修正しただけのコードです。
Sub test4()
　　Dim n As Long
　　Dim y As Long, x As Long
　　Dim ss As String
　　Dim c As Range
　　Const Y0 = 8, YY = 25, Ystp = 16 '縦方向 最初の行番、繰り返し回数,Step
　　Const X0 = 3, XX = 27, Xstp = 3 '列方向 最初の列番、繰り返し回数,Step
　　Dim dic As Object
　　Set dic = CreateObject("Scripting.Dictionary")
　　
　　For x = X0 To X0 + (XX - 1) * Xstp Step Xstp
　　　For y = Y0 To Y0 + (YY - 1) * Ystp Step Ystp
　　　　　For Each c In Cells(y, x).Resize(9)
　　　　　　ss = c.Value
　　　　　　If Len(ss) > 0 Then
　　　　　　　n = c.Offset(, 2).Value
　　　　　　　If Not dic.Exists(ss) Then
　　　　　　　　　dic(ss) = n
　　　　　　　ElseIf dic(ss) < n Then
　　　　　　　　　dic(ss) = n
　　　　　　　End If
　　　　　　End If
　　　　　Next
　　　　Next
　　Next
　　For x = X0 To X0 + (XX - 1) * Xstp Step Xstp
　　　For y = Y0 To Y0 + (YY - 1) * Ystp Step Ystp
　　　　　For Each c In Cells(y, x).Resize(9)
　　　　　　ss = c.Value
　　　　　　If Len(ss) > 0 Then
　　　　　　　　c.Offset(, 2).Value = dic(ss)
　　　　　　End If
　　　　　Next
　　　　Next
　　Next
　　
End Sub
【75220】Re:複数の範囲(膨大)を、変数に取り込む
お礼  初心者Ｍ  - 14/1/8(水) 18:04 -
引用なし
パスワード
   kanabun様

すぐに確認したところ、完璧に動いているようです。
大変ありがとうございます。

真ん中の列に関しては、今度こそ自分でやってみようと思います。

お暇で無いでしょうに、貴重なお時間を割いてくださったことに、心より感謝いたします。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1297 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free