Excel VBA質問箱 IV

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

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


10523 / 13646 ツリー ←次へ | 前へ→

【21303】いい案がありましたら教えてください。 たま 05/1/18(火) 16:48 質問[未読]
【21304】Re:いい案がありましたら教えてください。 IROC 05/1/18(火) 16:56 回答[未読]
【21306】Re:いい案がありましたら教えてください。 たま 05/1/18(火) 17:04 回答[未読]
【21308】Re:いい案がありましたら教えてください。 IROC 05/1/18(火) 17:22 回答[未読]
【21310】Re:いい案がありましたら教えてください。 たま 05/1/18(火) 17:35 回答[未読]
【21312】Re:いい案がありましたら教えてください。 IROC 05/1/18(火) 17:50 回答[未読]
【21315】Re:いい案がありましたら教えてください。 たま 05/1/18(火) 17:59 回答[未読]
【21317】Re:いい案がありましたら教えてください。 IROC 05/1/18(火) 18:17 回答[未読]
【21336】Re:いい案がありましたら教えてください。 たま 05/1/19(水) 8:41 お礼[未読]
【21326】Re:いい案がありましたら教えてください。 Hirofumi 05/1/18(火) 20:03 回答[未読]

【21303】いい案がありましたら教えてください。
質問  たま  - 05/1/18(火) 16:48 -

引用なし
パスワード
   ある配列があり、その配列を参考に新しい配列を作成したいのですが、なかなか良いモジュールが作成できません。ヒントで良いのでアドバイスの方お願い致します。

例) a(xx,1) -> b(xx,2) に変更したい。

a(xx,1)
(年月日,時間) 
1999/0506,18:00
1999/0506,18:00
1999/0506,18:10
1999/0507,18:00
1999/0507,18:10
  ↓
b(xx,2)
(年月日,時間)
1999/0506,18:00,2
1999/0506,18:10,1
1999/0507,18:00,1
1999/0507,18:10,1

aの配列で年月日と時間を比較していき、両方同じであればbの配列に同じであった数を
代入したい。

以上、よろしくお願い致します。

【21304】Re:いい案がありましたら教えてください。
回答  IROC  - 05/1/18(火) 16:56 -

引用なし
パスワード
   1次元配列ですか、2次元配列ですか?
シートで処理して、配列に入れるのはどうでしょうか?
配列変数だけで処理したいのでしょうか?

【21306】Re:いい案がありましたら教えてください。
回答  たま  - 05/1/18(火) 17:04 -

引用なし
パスワード
   IROC さん、早速ご回答いただきましてありがとうございます。
a(xx,1) , b(xx,2)とも二次元配列です。

出来れば配列変数のみで処理を行いたいです。
理由は、処理する数(xx)がエクセルで表示出来ないくらい大きいんです。
outputさせるだけでも結構な時間を使ってしまいますので...

以上、よろしくお願い致します。

【21308】Re:いい案がありましたら教えてください。
回答  IROC  - 05/1/18(火) 17:22 -

引用なし
パスワード
   >a(xx,1) , b(xx,2)
   ↑    ↑ 
データは配列にどのように入っているのでしょうか?
カンマで区切って、どこの要素に、どのデータがあるのか分からないです。
  

【21310】Re:いい案がありましたら教えてください。
回答  たま  - 05/1/18(火) 17:35 -

引用なし
パスワード
   記述不足で申し訳ありません。

以下のように配列に格納しています。

a(xx,1)
=>a(年月日,時間) 
a(1999/0506,18:00)
a(1999/0506,18:00)
a(1999/0506,18:10)
a(1999/0507,18:00)
a(1999/0507,18:10)
  :   :
  :   :
xxまで続く
  ↓
b(xx,2)
b(年月日,時間,回数)
b(1999/0506,18:00,2)
b(1999/0506,18:10,1)
b(1999/0507,18:00,1)
b(1999/0507,18:10,1)
  :   :
  :   :
xxまで続く

以上、よろしくお願い致します。

【21312】Re:いい案がありましたら教えてください。
回答  IROC  - 05/1/18(火) 17:50 -

引用なし
パスワード
   回数は、1 or 2 だけなのでしょうか?

もっと重複することはありますか?

【21315】Re:いい案がありましたら教えてください。
回答  たま  - 05/1/18(火) 17:59 -

引用なし
パスワード
   IROC さん、何度もご回答頂いてありがとうございます。
a(xx,1)、b(xx,2)とも二次元配列の縦の部分(xx)は変わりますが、横の部分(1 or 2)は
固定になります。

>もっと重複することはありますか?
=> 重複する数はまちまちになるのですが、(例)で例えた以上の重複はあります。
  100,200ぐらいの重複はあります。

以上、よろしくお願い致します。

【21317】Re:いい案がありましたら教えてください。
回答  IROC  - 05/1/18(火) 18:17 -

引用なし
パスワード
   いい案かどうかわかりませんが、私が思いつくのは、

ループ(For 〜 Next)を使って、Ifで一致するかどうか比較し、
重複件数をカウントします。
その際、重複データの削除はしないで、以下のようにします。

a(xx,1)
(年月日,時間) 
1999/0506,18:00
1999/0506,18:00
1999/0506,18:10
1999/0507,18:00
1999/0507,18:10
  ↓
1999/0506,18:00,2
1999/0506,18:00,2
1999/0506,18:10,1
1999/0507,18:00,1
1999/0507,18:10,1

その後、Dictionary オブジェクトに格納しながら重複を取り除きます。
その後、配列変数に戻せばよいかと思います。

【21326】Re:いい案がありましたら教えてください。
回答  Hirofumi  - 05/1/18(火) 20:03 -

引用なし
パスワード
   元のデータ配列は、基底0の配列で、日付が0列、時間が1列の有る物としています
結果の配列は、基底0の配列で、日付が0列、時間が1列、出現回数が2列と成ります
尚、一時的に配列が、3倍に膨れるので其の点が心配

Option Explicit

Public Sub Sample()

  Dim vntData As Variant
  Dim vntItem As Variant
  Dim vntResult As Variant
  Dim i As Long
  Dim dicIndex As Object
  Dim lngRow As Long
  Dim vntKey As Variant
  
  'テスト用データを作成
  'vntDataの配列は基底0の配列で、
  'vntData(lngRow, 0)に日付、vntData(lngRow, 1)に時間が入る物としています
  '詰まり、ActiveSheetのA列に日付、B列に時間が文字列で入力されている物とします
  With ActiveSheet.Cells(1, "A")
    lngRow = .Offset(65536 - .Row).End(xlUp).Row - .Row
    ReDim vntData(lngRow, 1)
    For i = 0 To lngRow
      vntData(i, 0) = .Offset(i).Value
      vntData(i, 1) = .Offset(i, 1).Value
    Next i
  End With
  
  'ここから本題
  'Dictionaryオブジェクトを取得
  Set dicIndex = CreateObject("Scripting.Dictionary")
  
  'dicIndexに就いて
  With dicIndex
    'データ配列の最後まで繰り返し
    For i = 0 To UBound(vntData, 1)
      'Keyを作成(Tabを挟んで、日付と時間を結合)
      vntKey = vntData(i, 0) & vbTab & vntData(i, 1)
      'もし、dicIndexにKeyが存在するなら
      If .Exists(vntKey) Then
        '項目に1つ加算
        .Item(vntKey) = .Item(vntKey) + 1
      Else
        'Keyと初期値1を登録
        .Add vntKey, 1
      End If
    Next i
    '元データを消去
    Erase vntData
    'dicIndexから、全てのKeyを取得
    vntKey = .Keys
    '結果用配列を確保
    ReDim vntResult(.Count - 1, 2)
    'Key全てに就いて
    For i = 0 To .Count - 1
      'Keyから日付を分離して、結果配列の0列に代入
      vntResult(i, 0) = Left(vntKey(i), _
          InStr(1, vntKey(i), vbTab, vbBinaryCompare) - 1)
      'Keyから時間を分離して、結果配列の1列に代入
      vntResult(i, 1) = Mid(vntKey(i), _
          InStr(1, vntKey(i), vbTab, vbBinaryCompare) + 1)
      'dicIndexからKeyに対する項目(出現回数)を取得し、
      '結果配列の2列に代入
      vntResult(i, 2) = .Item(vntKey(i))
    Next i
  End With
  '一時的に取得した配列を消去
  Erase vntKey
  'dicIndexを破棄
  Set dicIndex = Nothing
  
  '結果を確認の為、シートに出力
  With ActiveSheet.Cells(1, "D")
    .Resize(UBound(vntResult, 1) + 1, 3) = vntResult
  End With
  
End Sub

【21336】Re:いい案がありましたら教えてください。
お礼  たま  - 05/1/19(水) 8:41 -

引用なし
パスワード
   皆さん、ありがとうございます。

いいヒントを頂きました!。早速挑戦したいと思います。
作業中に分からないことがありましたらまた教えてください。

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