Excel VBA質問箱 IV

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

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


4931 / 13644 ツリー ←次へ | 前へ→

【53471】条件が一致したもののコピーについて tantan 08/1/15(火) 19:47 質問[未読]
【53473】Re:条件が一致したもののコピーについて ハチ 08/1/15(火) 21:29 発言[未読]
【53477】Re:条件が一致したもののコピーについて Sasurai 08/1/16(水) 1:03 回答[未読]
【53487】Re:条件が一致したもののコピーについて tantan 08/1/16(水) 19:02 質問[未読]
【53488】Re:条件が一致したもののコピーについて Sasurai 08/1/16(水) 20:58 回答[未読]
【53489】Re:条件が一致したもののコピーについて Sasurai 08/1/16(水) 21:19 回答[未読]
【53497】Re:条件が一致したもののコピーについて tantan 08/1/17(木) 12:49 質問[未読]
【53498】Re:条件が一致したもののコピーについて neptune 08/1/17(木) 15:36 回答[未読]
【53500】Re:条件が一致したもののコピーについて tantan 08/1/17(木) 21:29 お礼[未読]
【53499】Re:条件が一致したもののコピーについて Sasurai 08/1/17(木) 15:45 回答[未読]
【53501】Re:条件が一致したもののコピーについて tantan 08/1/17(木) 21:43 お礼[未読]

【53471】条件が一致したもののコピーについて
質問  tantan  - 08/1/15(火) 19:47 -

引用なし
パスワード
   初心者で苦しんでおります。どなたかご教授願います。

状況:
5000行位になる日々更新されるデータをCSV形式で取り込むデータがあります。

今エクセルファイルにそのCSVを取り込みデータを管理しています。
A列に製造番号があり以降各列に製造年月日などが入っています。
現在、Y列以降フリーにメモを記入していますが、このメモを新規にCSVを取り込んだ際にも、同じ製造番号の行へコピーしておきたいのです。

説明が下手で申し訳ありませんがやりたい事を簡単にいうと
同一形式のsheet1とsheet2の製造番号A列を比較し、同じ番号であればsheet1の
Y列より右側をすべてコピーする。といったものができればと思います。
5000行位あり、製造番号は新規なものが入ったり、古いものはなくなったりで
日々変わるのでどうすればよいのか悩んでおります。
どなたか良い方法がありましたら教えてください。


 A B C D E ・・・ X  Y  Z・・・
1番号        メモ メモ  
2
3          メモ
4

【53473】Re:条件が一致したもののコピーについて
発言  ハチ  - 08/1/15(火) 21:29 -

引用なし
パスワード
   ▼tantan さん:
>初心者で苦しんでおります。どなたかご教授願います。
>
>状況:
>5000行位になる日々更新されるデータをCSV形式で取り込むデータがあります。
>
>今エクセルファイルにそのCSVを取り込みデータを管理しています。
>A列に製造番号があり以降各列に製造年月日などが入っています。
>現在、Y列以降フリーにメモを記入していますが、このメモを新規にCSVを取り込んだ際にも、同じ製造番号の行へコピーしておきたいのです。
>
>説明が下手で申し訳ありませんがやりたい事を簡単にいうと
>同一形式のsheet1とsheet2の製造番号A列を比較し、同じ番号であればsheet1の
>Y列より右側をすべてコピーする。といったものができればと思います。
>5000行位あり、製造番号は新規なものが入ったり、古いものはなくなったりで
>日々変わるのでどうすればよいのか悩んでおります。
>どなたか良い方法がありましたら教えてください。

この
「製造番号は新規なものが入ったり、古いものはなくなったりで」
というのは、
「Sheet1のデータに製造番号がなければ、Sheet2には転記の必要はない」

であれば・・・
1、Sheet2のA列のRange(仮に変数Rng)をループ
2、Rngの製造番号でSheet1のA列をFind
3、あれば、Offsetした位置(Y列〜?列)のデータを、Rng.offsetにコピー

といった感じでは?


>
>
>  A B C D E ・・・ X  Y  Z・・・
>1番号        メモ メモ  
>2
>3          メモ
>4

【53477】Re:条件が一致したもののコピーについて
回答  Sasurai  - 08/1/16(水) 1:03 -

引用なし
パスワード
   サンプル

Sub sample()
 Dim dic As Object
 Dim endRow As Long
 Dim i As Long, j As Long
 Dim v1(), v2(), v3()
 
 With ThisWorkbook.Worksheets("Sheet1")
  endRow = .Cells(.Rows.Count, 1).End(xlUp).Row
  v1() = .Range("A1:A" & endRow).Value
  v2() = .Range("Y1:IV" & endRow).Value
 End With
 
 Set dic = CreateObject("Scripting.Dictionary")
 For i = 1 To endRow
  If Not dic.exists(v1(i, 1)) Then
   dic(v1(i, 1)) = i
  End If
 Next i
 
 With ThisWorkbook.Worksheets("Sheet2")
  endRow = .Cells(.Rows.Count, 1).End(xlUp).Row
  v1() = .Range("A1:A" & endRow).Value
  ReDim v3(1 To endRow, 1 To UBound(v2, 2))
  For i = 1 To endRow
   If dic.exists(v1(i, 1)) Then
    For j = 1 To UBound(v3, 2)
     v3(i, j) = v2(dic(v1(i, 1)), j)
    Next j
   End If
  Next i
  .Range("Y1").Resize(endRow, UBound(v3, 2)).Value = v3()
 End With
 
 Erase v1, v2, v3
 Set dic = Nothing
End Sub

【53487】Re:条件が一致したもののコピーについて
質問  tantan  - 08/1/16(水) 19:02 -

引用なし
パスワード
   ▼Sasurai さん:
ありがとうございます。
私がやりたかったことは、Sasuraiさんのsampleのとおりです!

が、、初心者の私には難しいコードばかりで
解読に時間を要してしまいました。返信が遅くなりすみません。
私がやりたかったことはこのとおりなんですが、質問のため
簡略化してしまい、実は
対比する番号はA列ではなくてJ3セル以下となってます。
そして、メモはY列ではなくてFG列より右に入っています。

Sasuraiさんのsampleを使ってなんとかやってみようといろいろ
試したのですが、わかりませんでした。。
ここまで、教えていただいてあつかましいお願いですが、
どこを変えればよいか教えていただけますでしょうか?

【53488】Re:条件が一致したもののコピーについて
回答  Sasurai  - 08/1/16(水) 20:58 -

引用なし
パスワード
   今回は解説付きです。前回と変わったところを比較すれば、だいたい
いじるところが分かってくると思います。
勉強してみてください。

Sub sample()
 Dim dic As Object
 Dim endRow As Long
 Dim i As Long, j As Long
 Dim v1(), v2(), v3()
 
 With ThisWorkbook.Worksheets("Sheet1")
  'Sheet1のJ列の最終行を取得
  endRow = .Cells(.Rows.Count, "J").End(xlUp).Row
  'Sheet1の製造番号を配列v1へ格納
  v1() = .Range("J3:J" & endRow).Value
  'Sheet1のメモを配列v2へ格納
  v2() = .Range("FG3:IV" & endRow).Value 
 End With
 
 '配列v1をループし辞書を作成する
 Set dic = CreateObject("Scripting.Dictionary")
 For i = 1 To endRow
  '製造番号に対応するメモの行を一旦、辞書に登録
  If Not dic.exists(v1(i, 1)) Then
   dic(v1(i, 1)) = i
  End If
 Next i
 
 With ThisWorkbook.Worksheets("Sheet2")
  'Sheet2のJ列の最終行を取得
  endRow = .Cells(.Rows.Count, "J").End(xlUp).Row
  'Sheet2の製造番号を配列v1へ格納
  v1() = .Range("J3:J" & endRow).Value
  'v3の配列サイズを決める    
  ReDim v3(1 To endRow, 1 To UBound(v2, 2))
  '配列v1をループし、製造番号に対応するメモを配列v3へ格納    
  For i = 1 To endRow  
   If dic.exists(v1(i, 1)) Then
    For j = 1 To UBound(v3, 2)
     v3(i, j) = v2(dic(v1(i, 1)), j)
    Next j
   End If
  Next i
  '配列v3をシートに出力する
  .Range("FG3").Resize(endRow, UBound(v3, 2)).Value = v3()
 End With
 '配列クリア
 Erase v1, v2, v3
 'オブジェクト解放
 Set dic = Nothing
End Sub

【53489】Re:条件が一致したもののコピーについて
回答  Sasurai  - 08/1/16(水) 21:19 -

引用なし
パスワード
   一部ミスがあったので訂正します。

Sub sample()
 Dim dic As Object
 Dim endRow As Long
 Dim i As Long, j As Long
 Dim v1(), v2(), v3()
 
 With ThisWorkbook.Worksheets("Sheet1")
  'Sheet1のJ列の最終行を取得
  endRow = .Cells(.Rows.Count, "J").End(xlUp).Row
  'Sheet1の製造番号を配列v1へ格納
  v1() = .Range("J3:J" & endRow).Value
  'Sheet1のメモを配列v2へ格納
  v2() = .Range("FG3:IV" & endRow).Value 
 End With
 
 '配列v1をループし辞書を作成する
 Set dic = CreateObject("Scripting.Dictionary")
 For i = 1 To Ubound(v, 1)  '--------------------------ここ訂正
  '製造番号に対応するメモの行を一旦、辞書に登録
  If Not dic.exists(v1(i, 1)) Then
   dic(v1(i, 1)) = i
  End If
 Next i
 
 With ThisWorkbook.Worksheets("Sheet2")
  'Sheet2のJ列の最終行を取得
  endRow = .Cells(.Rows.Count, "J").End(xlUp).Row
  'Sheet2の製造番号を配列v1へ格納
  v1() = .Range("J3:J" & endRow).Value
  'v3の配列サイズを決める    
  ReDim v3(1 To Ubound(v1, 1), 1 To UBound(v2, 2)) '-----ここ訂正

  '配列v1をループし、製造番号に対応するメモを配列v3へ格納    
  For i = 1 To Ubound(v1, 1)   '------------------------ここ訂正
   If dic.exists(v1(i, 1)) Then
    For j = 1 To UBound(v3, 2)
     v3(i, j) = v2(dic(v1(i, 1)), j)
    Next j
   End If
  Next i
  '配列v3をシートに出力する
  .Range("FG3").Resize(UBound(v3, 1), _
        UBound(v3, 2)).Value = v3()  '--------------ここ訂正

 End With
 '配列クリア
 Erase v1, v2, v3
 'オブジェクト解放
 Set dic = Nothing
End Sub

【53497】Re:条件が一致したもののコピーについて
質問  tantan  - 08/1/17(木) 12:49 -

引用なし
パスワード
   ▼Sasurai さん:
丁寧に解説までつけていただきありがとうございます。

今度は

> '配列v1をループし辞書を作成する
> Set dic = CreateObject("Scripting.Dictionary")
> For i = 1 To Ubound(v, 1)  '--------------------------ここでエラー
となってしまいました。


訂正前のものでは
>  '製造番号に対応するメモの行を一旦、辞書に登録
>  If Not dic.exists(v1(i, 1)) Then'--------------------------ここでエラー
となってしまいました。

何が原因かいろいろ確認したのですがわかりませんでした。
自分の試した状況が悪いのかもしれませんのでもう少し勉強し確認します。

【53498】Re:条件が一致したもののコピーについて
回答  neptune  - 08/1/17(木) 15:36 -

引用なし
パスワード
   ▼tantan さん:
横から失礼。

>▼Sasurai さん:
>丁寧に解説までつけていただきありがとうございます。
>
>今度は
>
>> '配列v1をループし辞書を作成する
>> Set dic = CreateObject("Scripting.Dictionary")
>> For i = 1 To Ubound(v, 1)  '--------------------------ここでエラー
>となってしまいました。
'配列v1をループし辞書を作成する
とありますし、vは宣言されてないので
For i = 1 To Ubound(v1, 1)
じゃないですか?誰でも、訂正忘れとか、ミスとかありますから。

>何が原因かいろいろ確認したのですがわかりませんでした。
>自分の試した状況が悪いのかもしれませんのでもう少し勉強し確認します。
せっかく頂いたサンプルですから理解してくださいね。
そうじゃないと、後で自分が困りますよ。

【53499】Re:条件が一致したもののコピーについて
回答  Sasurai  - 08/1/17(木) 15:45 -

引用なし
パスワード
   ▼tantan さん:
>▼Sasurai さん:
>丁寧に解説までつけていただきありがとうございます。
>
>今度は
>
>> '配列v1をループし辞書を作成する
>> Set dic = CreateObject("Scripting.Dictionary")
>> For i = 1 To Ubound(v, 1)  '--------------------------ここでエラー
>となってしまいました。
>
>
>訂正前のものでは
>>  '製造番号に対応するメモの行を一旦、辞書に登録
>>  If Not dic.exists(v1(i, 1)) Then'--------------------------ここでエラー
>となってしまいました。
>
>何が原因かいろいろ確認したのですがわかりませんでした。
>自分の試した状況が悪いのかもしれませんのでもう少し勉強し確認します。


失礼しました。
実際に動作確認せず修正したためのタイプミスです。
neptuneさんの言う通り、「v」ではなく「v1」です。
変数の宣言を見られれば分かりますよね?

neptuneさん、ありがとうございます。

【53500】Re:条件が一致したもののコピーについて
お礼  tantan  - 08/1/17(木) 21:29 -

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

>せっかく頂いたサンプルですから理解してくださいね。
>そうじゃないと、後で自分が困りますよ。

おっしゃる通りです。
気づかなかった自分と知識の無さが情けないです。
もっと勉強します!
ありがとうございました!

【53501】Re:条件が一致したもののコピーについて
お礼  tantan  - 08/1/17(木) 21:43 -

引用なし
パスワード
   ▼Sasurai さん:
どうもありがとうございました。
ちゃんと動作しました。
ちょっとしたことだったんですね。
気づかなかった自分が情けないです。

neptuneさんの言う通りもっと勉強したいと思います。

とても助かりました。
解説など本当に丁寧な対応ありがとうございました!

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