Excel VBA質問箱 IV

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

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


1300 / 13645 ツリー ←次へ | 前へ→

【75198】複数の異なる値を取り込んで、順に処理したいです 初心者M 14/1/7(火) 10:38 質問[未読]
【75199】Re:複数の異なる値を取り込んで、順に処理... kanabun 14/1/7(火) 14:56 発言[未読]
【75201】Re:複数の異なる値を取り込んで、順に処理... 初心者M 14/1/7(火) 15:29 お礼[未読]
【75202】Re:複数の異なる値を取り込んで、順に処理... 初心者M 14/1/7(火) 15:54 お礼[未読]
【75203】Re:複数の異なる値を取り込んで、順に処理... kanabun 14/1/7(火) 17:05 発言[未読]
【75204】Re:複数の異なる値を取り込んで、順に処理... 初心者M 14/1/7(火) 17:28 お礼[未読]

【75198】複数の異なる値を取り込んで、順に処理し...
質問  初心者M  - 14/1/7(火) 10:38 -

引用なし
パスワード
   初めて質問します。過去ログ拝見しましたが、解決策が無いようでしたので書きます。

ある表を整理する方法で悩んでいます。

5100 A
7600 イ
6800 イ

などのようなデータが数行に渡って存在する表で、同じ「イ」なら大きい数の7600に合わせる、というような処理をしたいです。
「A」や「イ」などの記号は、無作為に数パターン存在します。

アレイ関数や配列変数などいろいろ調べてみたのですが、上手い手が思いつきません。
記号を取り込んで、順に取り出せるような処理をお教えいただけませんか。

参考までに、記号が無作為でなく、「A」と決め打ちであれば、下のコードで動きます。

初心者なのでお恥ずかしいですが載せておきます。
宜しくお願い致します。

___________________________________

Public Sub 持ち上げ()

Dim x As Integer '行
Dim y As Integer '列

Dim Int1 As Integer '部数
Dim Int2 As Integer '部数最大値


'最大値を取得

For x = 6 To 44
  For y = 8 To 33
  
    If Cells(x, y).Value = "A" Then
    
      Int1 = Cells(x, y - 1).Value
      
        If Int1 > Int2 Then
        Int2 = Int1
       
        End If
    End If
  
  Next
Next

'最大値に揃える

For x = 6 To 44
  For y = 8 To 33
  
    If Cells(x, y).Value = "A" Then
Cells(x, y - 1).Value = Int2

 End If
  Next
Next

【75199】Re:複数の異なる値を取り込んで、順に処...
発言  kanabun  - 14/1/7(火) 14:56 -

引用なし
パスワード
   ▼初心者M さん:

 A列  B列
>5100 A
>7600 イ
>6800 イ
>
>などのようなデータが数行に渡って存在する表で、同じ「イ」なら大きい数の7600に合わせる、というような処理をしたいです。
>「A」や「イ」などの記号は、無作為に数パターン存在します。

>参考までに、記号が無作為でなく、「A」と決め打ちであれば、下のコードで動きます。
その考え方でいいとおもいますよ。

簡単のため、表は A列、B列だけの構成と考えます。

以下は、「A」だけでなく、複数のキーワードに対応するために、
Dictionaryオブジェクトを使って複数キーワードを登録できるように
したものです。
あるキーワードがまだ辞書に登録されていなければ、そのキーワードと
その行のA列の数値を「組データ」として登録しておきます。
すでに登録済みのキーワードが出てきたら、その行のA列の数値を 現在登録
されている数値と比較して、これより大きいときだけ、そのキーの数値を更新
します。
これを最後の行まで繰り返すと、キーワードごとに数値の最大値の入った配列
ができますので、
最後にもとのA列をこの配列で上書きしてやります。

Sub test()
  Dim a, b
  Dim i As Long
  Dim r As Range
  Dim dic As Object
  Set dic = CreateObject("Scripting.Dictionary")
  
  Set r = Range("A6", Range("A6").End(xlDown))
  a = r.Value       'A列の値
  b = r.Offset(, 1).Value 'B列の値
  For i = 1 To 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 UBound(b)
    a(i, 1) = dic(b(i, 1))
  Next
  r.Value = a
  
End Sub

【75201】Re:複数の異なる値を取り込んで、順に処...
お礼  初心者M  - 14/1/7(火) 15:29 -

引用なし
パスワード
   kanabun様

お返事ありがとうございます。
Dictionaryオブジェクトという概念は初耳で、大変勉強になります。

教えていただいたコードを早速手元の表に応用しようと思うのですが、何分初心者なので明日までかかるかと思います。

まずはお礼まで。何卒今後も、お時間と余裕があればご指導の程よろしくお願いいたします。

【75202】Re:複数の異なる値を取り込んで、順に処...
お礼  初心者M  - 14/1/7(火) 15:54 -

引用なし
パスワード
   kanabun様

お世話になります。度々すみません。
試したところ、上手くいきました!後は、元々の表に合わせてうまいこと変えていくだけです。これも大変そうですが、多分できると思います。

頂いたコードを最初に試した際、何故か「最小値」を取ってきてしまっていたので

ElseIf dic(b(i, 1)) > a(i, 1) Then

の「>」を「<」に変えたところ、上手くいきました。

これで、私の課の作業効率が上がります。
本当にありがとうございました。

【75203】Re:複数の異なる値を取り込んで、順に処...
発言  kanabun  - 14/1/7(火) 17:05 -

引用なし
パスワード
   ▼初心者M さん:

>頂いたコードを最初に試した際、何故か「最小値」を取ってきてしまっていたので
>
>ElseIf dic(b(i, 1)) > a(i, 1) Then
>
>の「>」を「<」に変えたところ、上手くいきました。

あー、逆でした。失礼しました m(_ _)m
おわびに、
[H6]セルを先頭とする39行×26列の表があるときの test応用です。

Sub test2()
  Dim a
  Dim i As Long, j As Long, n As Long
  Dim r As Range
  Dim dic As Object
  Set dic = CreateObject("Scripting.Dictionary")
  
  Set r = Range("H6").Resize(39, 26) '[H6]を左上とする39行×26列
  a = r.Value       '表全部の値

  For j = 2 To UBound(a, 2) Step 2 '列方向 1列おき
    For i = 1 To UBound(a, 1)   '行方向
      If Not IsEmpty(a(i, j)) Then
       n = a(i, j - 1)
       If Not dic.Exists(a(i, j)) Then
         dic(a(i, j)) = n
       ElseIf dic(a(i, j)) < n Then
         dic(a(i, j)) = n
       End If
      End If
    Next
  Next
  For j = 2 To UBound(a, 2) Step 2 '列方向 1列おき
    For i = 1 To UBound(a, 1)   '行方向
      If Not IsEmpty(a(i, j)) Then
        a(i, j - 1) = dic(a(i, j))
      End If
    Next
  Next
  r.Value = a
  
End Sub

いちおう、空白セルは実行しないようにしました。

【75204】Re:複数の異なる値を取り込んで、順に処...
お礼  初心者M  - 14/1/7(火) 17:28 -

引用なし
パスワード
   kanabun様

引き続き有り難うございます。
Resizeというのも初めて見ました。きちんと意味を理解して使いたいので、これからDictionaryと併せて勉強していきます。

こういった物をパッと作れる方は本当に尊敬します。

また行き詰ったらこの掲示板でお力をお借りするかも知れません。
この度は本当に助かりました。

有り難うございました。

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