| |
▼kanabun さん：
ありがとうございます
アドバイスどおりやってみたところうまくいきました
でも、一つ問題が･･･あって、すごく時間がかかるということです。
dictionaryで格納したものを、
今度は、違うシートの2行目から最終行まで、チェックし、
格納した品番だったら、Ｃ列に、先ほどの格納した日付を入力するというマクロを組んでいるのですが、すごく時間がかかってしまいます
dictionaryオブジェクト意外に、何か、違う方法はないものか？と
いろいろネットを見ているのですが、なかなか見つかりません
もし、いい方法があれば・・・？と思っているのですが・・・
もし、あれば伝授していただきたいです
シート1
Ａ列；品番
Ｂ列；CODE
Ｃ列；日付
シート2
Ａ列；品番
Ｂ列；CODE
Ｃ列；最短日付
※【シート2】に、品番がマッチしたらＣ列に最短日付を入れる
今は下記のような記述になってます
Dim MyD As Object
Dim MyVal, MyVal2
Dim MyDate As Date
Dim MyKey, MyItem
Set MyD = CreateObject("scripting.dictionary")
Sheets("シート1").Activate
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
MyVal = Cells(i, "A").Value & "|" & Cells(i, "B").Value '品番とCODE
MyDate = Cells(i, "C").Value
If Not MyD.exists(MyVal) Then
MyD.Add MyVal, Cells(i, "C").Value '日付
Else
If MyD(MyVal) > MyDate Then MyD(MyVal) = MyDate
End If
Next i
MyKey = MyD.keys
MyItem = MyD.items
Sheets("シート2").Activate
For i = 0 To UBound(MyKey)
MyVal2 = Split(MyKey(i), "|")
For z = 4 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(z, "A").Value = MyVal2(0) Then '同じ品番だったら
Cells(z, "B").Value = MyVal2(1) 'code
Cells(z, "C").Value = MyItem(i) '日付
End If
Next z
Next i
>▼Tacchi さん：
>こんにちは。
>
>>同じ品番の中で一番日付が最短のものを格納したいと思っていますが、
>>どうも、うまくいきません
>
>未検証ですが、以下では？
>
>>Dim MyD As Object
> Dim MyVal As String, MyVal2
> Dim myDate As Date
>>
>>Set MyD = CreateObject("scripting.dictionary")
>>
>>For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
>> MyVal = Cells(i, "A").Value & "|" & Cells(i, "B").Value
> myDate = Cells(i, "C").Value
>> If Not MyD.exists(MyVal) Then
>> MyD.Add MyVal, myDate
>> Else
>> ’ココで、もし、同じ品番があったら、すでに格納されてる
>> ' 日付と比べて、最短のほうを格納する
>> ' といった方法をとりたいです
> If MyD(MyVal) < myDate Then MyD(MyVal) = myDate
>
>> End If
>>Nex i
|
|
Tacchi
- 10/11/15(月) 8:44 -
