アプリ版:「スタンプのみでお礼する」機能のリリースについて

いつもお世話になっております。
現在dictionary勉強中ですが、なかなかコツをつかめず
思ったとおりのマクロを作成することができません(ノ_;)

ところで、今回作成しているのは
元データ.xlsというファイルのシート(データ)に
  |【A】| B | C |【D】| E | F |・・・|H|I|【J】|K
3  【顧客ID】|顧客|受付日|【担当】|・・・|【会場名】|(見出し)
4  データの始まり↓

と、ありまして、

集計データ.xlsのシート(集計)に
 | A | B | C | D | E | F |
1 顧客ID|担当|会場名|

と二行目から一覧表があります。

A列のIDが一致するものに
Sheet(データ)  →  Sheet(集計)
 セル( i, "D")の値 → セル( j, "B") に
セル( i, "J")の値 → セル( j, "C")に
    セル(j,"C")に値が入っているとき、セル(j,"D")に→Fまで(4回のみ)
A列のIDが一致するものがない時
セル( i, "A")の値 → セル( 最終,"A")に
 セル( i, "D")の値 → セル( 最終, "B") に
セル( i, "J")の値 → セル( 最終,"C")に追加


というように、入れたいのですが、
以下のようなコードをネットで見つけ自分なりに考えて変更を加えてみましたが
あまり分かっていないためどのように変更すればいいのかよく分かりません。どなたかご教授ください。お願いします。
Sub Try()
Dim data_1() As String
Dim data As Long
Dim maxrow As Long
Dim t As Integer, f As Integer, y As Integer

Set ws1 = Worksheets("集計")
Set ws2 = Worksheets("データ")
Application.ScreenUpdating = False
maxrow = ws2.Range("a65536").End(xlUp).Row

With ws1
For i = 2 To Range("a65536").End(xlUp).Row
data = .Cells(i, 1)
f = 0
t = 0
With ws2
t = Application.WorksheetFunction.CountIf(.Range("a4:a" & maxrow), data)
If t > 0 Then
For n = 1 To maxrow
ReDim Preserve data_1(f)
If data = .Cells(n, 1) Then
data_1(f) = .Cells(n, 10)
f = f + 1
If t = f Then Exit For
Else
'A列にIDが存在しなければ追加する:ここの記述がよく分かりません。
data_1(f) = .Cells(n, 1)
End If
Next n

For y = 0 To UBound(data_1)
ws1.Cells(i, maxcol(i)) = data_1(y)
Next y
End If
End With
Next i
End With
Application.ScreenUpdating = True
End Sub
'--------------------------
Private Function maxcol(ByVal i As Long) As Integer
Dim j As Integer

With Worksheets("集計")
j = 4
Do While .Cells(i, j) <> ""
j = j + 1
Loop
maxcol = j
End With
End Function

A 回答 (14件中1~10件)

>A列のIDが一致するものに


>A列のIDが一致するものがない時
ここが不明です。
何と一致する・しないと言っているのか?

あと、コードとタイトルの関係が不明。

例えば、重複のあるIDを前に・重複のないIDを後ろに、と言う事なら
何となく理解できますけど。。。?

この回答への補足

重複のあるIDの場合C列以降のデータを追加
重複のないIDの場合後ろに
データを追加

です。

補足日時:2008/07/11 07:30
    • good
    • 0

>セル(j,"C")に値が入っているとき、セル(j,"D")に→Fまで(4回のみ)


重複は4つまでしかないのでしょうか?
5つ以上あるとした場合、4つとは上からor下から?

>dictionary勉強中ですが・・・
Excel(エクセル) VBA入門:Dictionaryオブジェクトを利用する
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/v …
ご参考まで。

この回答への補足

重複は4つまで、というか基本的にA列目の重複は一つしかありません。
見つからない場合はA列目データを集計シートに追加し
見つかったときには
四回までデータを取り込むようにしたいのです
説明不足ですみません

補足日時:2008/07/11 09:29
    • good
    • 0

私ならDictionaryを用いますが、過去ログを検索してみては?


”重複”関連も結構ありますよ。
(”OKWaveコミュニティー > デジタルライフ > ソフトウェア > Office系ソフト”
 こちらとかの過去ログも参考になります。

ただ、重複しているものを上に・重複のないものを後ろには、
質問としては私は初めて見ましたので、まったく同じ物が
見つかるかはわかりません。

この回答への補足

アドバイスありがとうございます
一応過去ログは読ませていただきましたが載っていなかったので質問しました

補足日時:2008/07/11 11:36
    • good
    • 0

>dictionary勉強中ですが・


dictionaryはVBSや.NETの概念ではないですか。エクセルVBA独自でそんな機能ありましたっけ。私の不勉強ならすみません。
何で難しい概念・仕組みで解決する必要があるのかな。
ーー
この質問をざっと見て、Findメソッドで「顧客ID」を同じものを他ファイル「集計データ」側で見つけ、そこにデータまたは「顧客ID」で集計済みデータを代入したらよいようなんだが。
こんなに長いコードにならないのではないですか。
見つからなければ最終行以下に追加。
ーー
両ファイルのレコードの並び順と重複出現の点は書いて置いてください。
集計データの顧客ID他は(前月作業とかで)暫定的に中身が出来上がっているのですか。
ーー
読者のことも考えて、読者に長いコードを解読させるコード実例は困る。今後は要点を文章で添えるとかポイントを絞る質問をお願いします。

この回答への補足

Findですね。ありがとうございます。調べます。

補足日時:2008/07/11 12:51
    • good
    • 0

>元データ.xlsというファイルのシート(データ)に


>集計データ.xlsのシート(集計)に
よくよく読むとBookが違ったのですね。

集計シートには既にデータがあり、追加・変更が目的なのか、
データシートのデータ追加・変更等で、その都度集計シートを白紙にして、
全て書き換えてしまっていいのか、
で違ってきますね。
私はてっきり後者だとばかり思っていたものですから、
見当違いのアドバイスだったかも?

imogasiさんへ
>dictionaryはVBSや.NETの概念ではないですか。エクセルVBA独自でそんな機能ありましたっけ。
私もVBSの機能だと思いますよ。
ExcelVBAの参考書では余り書いてないように見受けられ、VBScriptの参考書を
見ながら勉強してますし。

この回答への補足

追加変更が目的で追加というところで悩んでます。
Dictionary勉強中なのでそのあたりを出来れば教えていただきたいのですが…
ケータイからの投稿ですのでちゃんと書きたいことがすべて書けていません
すみません

補足日時:2008/07/11 12:49
    • good
    • 0

>追加変更が目的で追加というところで悩んでます。


であればANo.4での回答の通り、Findで見つからない場合の
処理でいいのでは?

私がDictionaryを回答したのは、ANo.5に記載した通りの事だと
思っていましたので。

>Dictionary勉強中なのでそのあたりを出来れば教えていただきたいのですが…
正直私も解説できるほど理解はしてないです。
他の方の回答されたコードを自分で試してみて、の手探り状態で勉強
していましたので。
    • good
    • 0

Sub try()


  Dim ws As Worksheet
  Dim dic As Object
  Dim v  As Variant '集計データ格納用配列
  Dim w  As Variant '元データ格納用配列
  Dim i  As Long
  Dim j  As Long
  Dim k  As Long
  Dim x  As Long
  
  Set ws = Workbooks("集計データ.xls").Sheets("集計")
  '追加考慮し大きめに配列取る。
  v = ws.Range("A1:F65536").Value
  '最終データ行を取得しておく。
  x = ws.Range("A65536").End(xlUp).Row
  
  With Workbooks("元データ.xls").Sheets("データ")
    w = .Range("J4", .Cells(.Rows.Count, 1).End(xlUp)).Value
  End With
  'Dictionaryオブジェクトに既集計キーを読み込む。同時にItemに行を記憶。
  Set dic = CreateObject("scripting.dictionary")
  For i = 1 To x
    dic(v(i, 1)) = i
  Next
  
  For j = 1 To UBound(w)
    'Existsメソッドで存在確認。それにより分岐。
    If dic.exists(w(j, 1)) Then
      i = dic(w(j, 1))
      For k = 4 To 6
        If IsEmpty(v(i, k)) Then
          v(i, k) = w(j, 10)
          Exit For
        End If
      Next
    Else
      x = x + 1
      dic(w(j, 1)) = x
      v(x, 1) = w(j, 1)
      v(x, 2) = w(j, 4)
      v(x, 3) = w(j, 10)
    End If
  Next
  
  With ws.Cells(1).Resize(x, 6)
    .ClearContents
    .Value = v
  End With
  
  Set dic = Nothing
  Set ws = Nothing
End Sub

Dictionaryオブジェクトはプロパティやメソッドがシンプルで、使い勝手が良く、
特にExistsメソッドは高速に処理できますから便利ですね。
私も好きです。
ただ今回のケースは『勉強』に適した題材かというと、ちょっと厳しいかもしれませんね。
基本についても押さえておかれたほうが良いと思います。
http://msdn.microsoft.com/ja-jp/library/cc428065 …
http://www.geocities.jp/cbc_vbnet/Scripting/dict …
    • good
    • 0
この回答へのお礼

ありがとうございます。私もはやくディクショナリーを使いこなせるようになりたいです。。。
本当にすごくスマートで素敵なコードに感動しています!!
更に、基本がわかるサイトまでご紹介いただいてご丁寧な対応に本当に感謝しています。

お礼日時:2008/07/12 11:43

質問、補足など読んでいくといくつか重要な点が抜けてます。


それらを補足してください。
さすれば質問者のレベルに合わせたDictionaryオブジェクトをアップすることに吝かではありませぬ。

 
(1)コードは、元データ.xls、集計データ.xlsのどちらに書いてあるのか

(2)元データ.xls、集計データ.xlsは予め両方とも開いているか

(3)集計データ.xlsの転記されるエリアはマクロ実行の最初でクリアーしなくていいのか

(4)重複4つと書いてあるが実際は重複とは関係なくこのマクロが実行されるたびに、列方向へ転記するのではないのか

  これはどういうことかと言うと、
  ID番号2005があり、今月のデータから転記され
  次回の処理(来月のデータ)でまた、2005が発生していた場合など。

(3)と(4)は関係あり

以上。
 

この回答への補足

ありがとうございます。
まず、
(1)コードは集計データに書きます。
(2)この部分は今まだ作成中なのですが、
Dim mb As Workbook, wb As Workbook
Dim myfdr As String, fname As String, n As Integer
Dim objFSO
Dim objFOL
Dim objWK
Set mb = ThisWorkbook 'このブック(集計)をmbとする
Set objFSO = CreateObject("Scripting.FileSystemObject")
myfdr = ThisWorkbook.Path
Set objFOL = objFSO.GetFolder(myfdr)
For Each objWK In objFOL.SubFolders
という風に、サブフォルダーの中から「元データファイル」を
探してきて、

For Each f In objWK.Files
If fso.GetExtensionName(f.Path) = "xls" And f.Name = "元データ.xls" Then

With Workbooks.Open(f.Path)

というようにオープンメソッドを使う予定にしております。

(3)集計データはクリアしません。
追加の顧客IDが存在するかどうか調べて追加する&既存の顧客IDには増えた【会場名】データ(J列)のみを追加するためです。

(4)元データ
一回目
  |【A】| B | C |【D】| E | F |・・・|H|I|【J】|K
3  【顧客ID】|顧客|受付日|【担当】| ・・・ |【会場名】|(見出し)
4  2005 |  ・・・・山田|  ・・・・会場A|
  2006 |  ・・・・・田中|  ・・・・空白|

二回目
  |【A】| B | C |【D】| E | F |・・・|H|I|【J】|K
3  【顧客ID】|顧客|受付日|【担当】|・・・|【会場名】|(見出し)
4  2005 | ・・・・山田| ・・・・会場B|←書き換えデータ
   2006 ・・・・・|田中| ・・・・会場C|←書き換えデータ
のとき、


集計データは
一回目
| A | B | C | D | E | F |
1 顧客ID|担当|会場名|
 2005 |山田|会場A|
 2006 |田中|空白|

二回目
| A | B | C | D | E | F |
1 顧客ID|担当|会場名(1)|会場名(2)
 2005 |山田|会場A|会場B|
 2006 |田中|空白 |会場C
とする予定です。

補足日時:2008/07/12 11:57
    • good
    • 0

再度の登場、onlyromです。



'------------------------------------------------- 
Sub Test()
 Dim R As Long
 Dim Clm As Integer
 Dim LastRow As Long
 Dim TargetRow As Long
 Dim BookPath As String
 Dim myDic

 Set myDic = CreateObject("Scripting.Dictionary")

 Sheets("集計").Select

 For R = 2 To Cells(Rows.Count, "A").End(xlUp).Row
   If myDic.Exists(Cells(R, "A").Value) = False Then
     myDic.Add Cells(R, "A").Value, R
   End If
 Next R

 BookPath = ThisWorkbook.Path
 Workbooks.Open BookPath & "\元データ.xls"

 With ThisWorkbook.Sheets("集計")
  For R = 4 To Cells(Rows.Count, "A").End(xlUp).Row
    If myDic.Exists(Cells(R, "A").Value) Then
      TargetRow = myDic.Item(Cells(R, "A").Value)
      .Cells(TargetRow, "B").Value = Cells(R, "D").Value
      Clm = .Cells(TargetRow, Columns.Count).End(xlToLeft).Column
      .Cells(TargetRow, Clm + 1).Value = Cells(R, "J").Value
    Else
      LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
      .Cells(LastRow + 1, "A").Value = Cells(R, "A").Value
      .Cells(LastRow + 1, "B").Value = Cells(R, "D").Value
      .Cells(LastRow + 1, "C").Value = Cells(R, "J").Value
      myDic.Add Cells(R, "A").Value, LastRow + 1  '●重要
    End If
  Next R
 End With

 Workbooks("元データ.xls").Close False
End Sub
'----------------------------------------------------- 

●重要 、について
集計シートにないIDは、集計シートの最後に追加するのですが、
さらに、そのIDが重複もしてる場合も想定しているため。
 
尚、上記コードはわざとオブジェクト変数は使ってありませんが
実際は、Select,Activateメソッドなど使用しないように
オブジェクト変数を使う方がベターでしょう。

それから、元データ.xlsはThisworkbookのPathから開いています。
 
以上。
    • good
    • 0
この回答へのお礼

ありがとうございます。
非常にわかりやすく
わたしのレベルに合わせてくださっているということが
すごくよくわかります。
本当に感謝いたします。

お礼日時:2008/07/12 18:46

>二回目


>   A | B | C   | D   | E | F |
>1 顧客ID|担当 |会場名(1)|会場名(2)|
>  2005 |山田 |会場A  |会場B  |
>  2006 |田中 |空白   |会場C  |

これは、空白セルは詰めないという事ですね。
その場合は以下のように修正が必要です。

Sub try2()
  'VBE[ツール][参照設定]で『Microsoft Scripting Runtime』にチェック
  Dim ws As Worksheet
  Dim dic As Scripting.Dictionary
  Dim v  As Variant '集計データ格納用配列
  Dim w  As Variant '元データ格納用配列
  Dim i  As Long
  Dim j  As Long
  Dim k  As Long
  Dim x  As Long
  
  With Workbooks("元データ.xls").Sheets("データ")
    w = .Range("J4", .Cells(.Rows.Count, 1).End(xlUp)).Value
  End With
  
  Set ws = Workbooks("集計データ.xls").Sheets("集計")
  With ws.Cells(1).CurrentRegion
    x = .Rows.Count
    k = .Columns.Count + 1
    v = .Resize(x + UBound(w), k).Value
  End With
  v(1, k) = "会場名(" & k - 2 & ")"
  
  Set dic = New Scripting.Dictionary
  For i = 1 To x
    dic(v(i, 1)) = i
  Next
  
  For j = 1 To UBound(w)
    If dic.Exists(w(j, 1)) Then
      i = dic(w(j, 1))
      v(i, k) = w(j, 10)
    Else
      x = x + 1
      dic(w(j, 1)) = x
      v(x, 1) = w(j, 1)
      v(x, 2) = w(j, 4)
      v(x, k) = w(j, 10)
    End If
  Next
  
  With ws.Cells(1).Resize(x, k)
    .ClearContents
    .Value = v
  End With
  
  Set dic = Nothing
  Set ws = Nothing
End Sub
※2回目実行前にはD列には何も入力しておかない事、
 3回目実行前にはE列には何も入力しておかない事、が条件です。

ついでに事前に[参照設定]する書き方にしてみました。(事前バインディング)
そうしておくと、
dic.
のあとに[プロパティ/メソッドの一覧]が表示されるVBEインテリセンス(入力支援)が効きますから
コーディングが楽になるでしょう。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!