[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『日付(1900/1/0)の置換をマクロで』（やまびこ）
いつも拝見しながら勉強させていただいています。 早速質問なのですが、マクロ記録し、多少の変更をしながら使用しており、躓いてしまいました。
sheet1 1 商品コード 発注数 納品希望日 2 001 10 2007/12/4 3 025 15 2008/1/15 4 034 5 057 20 2007/12/15 6 089 7 125 30 2007/12/15 ･ ･ などと店舗毎に１シート、複数シートより１シートまとめるマクロを記録して、 多少の手を加えて使用しています。
集計sheet 1 商品コード Ａ店 Ｂ店 2 発注数 納品希望日 発注数 納品希望日 3 001 10 2007/12/1 4 003 0 1900/1/0 5 010 5 2007/12/3 6 015 0 1900/1/0 10 2007/12/4 7 025 15 2008/1/15 0 1900/1/0 8 034 9 045 0 1900/1/0 10 057 20 2007/12/15 ･ ･
集計SheetにはVLOOKUPで該当する商品コードを参照し、最終的には値貼り付けしているのですが、 店舗によっては発注しない品目があり、VLOOKUPで参照すると"0"が返る場合があります。 日付の"0"を""にしたく、置換をしたいのですが、シリアル値では「39420」も「3942」と なってしまう為、日付の表示形式を「YYYY/M/D」にし、0値は「1900/1/0」となるので 置換を行い、1900/1/0を""にするようマクロを記録し、コードを走らせて見たのですが 置換ができません。 メニュー→編集、もしくはCtrl+H から行うと問題ないのですが、マクロではなぜか…。 以下が記録したコードです。
Cells.Replace What:="1900/1/0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
なぜだか原因がわからず、躓いております。 もしくは他にもっとよい方法がある（VLOOKUPから値貼り付けをしない方法）と思うのですが…。 どなたかご教授お願いします。
Excel2003、WindowsXPです。
VLOOKUPの式を提示してみては？ (元夏バテ)
Sheet1がA店とし、 集計Sheet B3=VLOOKUP($A3,A店!$A$C,COLUMN(B3),0) C3へフィル、下へフィル D3=($A3,B店!$A$C,COLUMN(B3),0) E3へフィル、下へフィル と、シート数（店舗数）分右へいきます。 これをマクロにて入力しています。 （やまびこ)
VLOOKUPを使用しない一例です。
Sheet1、Sheet2のデータをSheet3に抽出しとります。
（弥太郎）
'-----------------------
Option Base 1
Sub yamabiko()
Dim dic As Object, i As Long, j As Integer, u As Long, x, y, sht
Set dic = CreateObject("scripting.dictionary")
sht = Array("Sheet1", "Sheet2")
With Sheets("Sheet3")
tbl = .Cells(3, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 2).Value
For i = 1 To UBound(tbl, 1)
dic(tbl(i, 1)) = i
Next i
End With
ReDim x(1 To UBound(sht), 1 To dic.Count, 1 To 2)
For j = 1 To UBound(sht)
With Sheets(sht(j))
tbl = .Cells(2, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 1, 3)
For i = 1 To UBound(tbl, 1)
If dic.exists(tbl(i, 1)) Then
x(j, dic(tbl(i, 1)), 1) = tbl(i, 2)
x(j, dic(tbl(i, 1)), 2) = tbl(i, 3)
End If
Next i
End With
Next j
ReDim y(1 To dic.Count, 1 To 2)
j = 0
With Sheets("sheet3")
.Cells(3, 2).Resize(dic.Count, Columns.Count - 2).ClearContents
For i = 1 To UBound(sht)
For u = 1 To dic.Count
y(u, 1) = x(i, u, 1)
y(u, 2) = x(i, u, 2)
Next u
j = j + 2
.Cells(3, j).Resize(dic.Count, 2) = y
Next i
End With
Set dic = Nothing
End Sub
弥太郎さん！ありがとうございます！
で、早速やってみたんですが、Sheet2しか反映されません＞＜ 私にはdictionaryがなかなか理解しきれておらず。。。 なんとか問題の箇所を理解しようとがんばってみてはいるのですが…。 理屈はわかるのですが、変数がいっぱい…で？？？？です(T-T) (やまびこ)※HN忘れてましたm(__)m
ごめんなはれや、ウォーキングに出かけとりましたもんで、ふぅふぅ。＾＾ これはやまびこはん、単にOption Base 1をコピペしてないだけとちゃいまっか？ （弥太郎）
弥太郎さん、すみません。そのとおりでした。。。 コピペした時に「Option Base 1」が不完全でした(^-^; 失礼いたしました。
他の似たような作業があるブックでも応用したいのですが、 参照するのが1シートのみで、VLOOKUPで返していた列が6列なら
ReDim x(1 To dic.Count, 1 To 6)
With Sheets("Sheet1")
tbl = .Cells(2, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 1, 7)
For i = 1 To UBound(tbl, 1)
If dic.exists(tbl(i, 1)) Then
x(dic(tbl(i, 1)), 1) = tbl(i, 2)
x(dic(tbl(i, 1)), 2) = tbl(i, 3)
x(dic(tbl(i, 1)), 3) = tbl(i, 4)
x(dic(tbl(i, 1)), 4) = tbl(i, 5)
x(dic(tbl(i, 1)), 5) = tbl(i, 6)
x(dic(tbl(i, 1)), 6) = tbl(i, 7)
End If
Next i
End With
ReDim y(1 To dic.Count, 1 To 6)
j = 0
With Sheets("sheet3")
.Cells(3, 2).Resize(dic.Count, Columns.Count - 2).ClearContents
For u = 1 To dic.Count
y(u, 1) = x(u, 1)
y(u, 2) = x(u, 2)
y(u, 3) = x(u, 3)
y(u, 4) = x(u, 4)
y(u, 5) = x(u, 5)
y(u, 6) = x(u, 6)
Next u
.Cells(3, 2).Resize(dic.Count, 6) = y
End With
で大丈夫ですか？
(やまびこ)
えとdictionaryに格納するコードは？ （弥太郎）
dictionaryに格納されとったら
ReDim x(1 To dic.Count, 1 To 6)
With Sheets("Sheet1")
tbl = .Cells(2, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 1, 7)
For i = 1 To UBound(tbl, 1)
If dic.exists(tbl(i, 1)) Then
For n = 1 To UBound(x, 2)
x(dic(tbl(i, 1)), n) = tbl(i, n + 1)
Next n
End If
Next i
End With
With Sheets("sheet3")
.Cells(3, 2).Resize(dic.Count, Columns.Count - 2).ClearContents
.Cells(3, 2).Resize(dic.Count, 6) = x
End With
でよろしいんとちゃいまっしゃろか？
（弥太郎）
遅くなりました。弥太郎さま。 なるほどです。少し理解できた気がします(^-^; ありがとうございました。 (やまびこ)
すみません。上記のコードを実行していたらエラーになってしまいました。 調べてみたら tblは267までなのですが、dicに格納されているItemは256まででした。 dictionaryの上限(最大数)ってあるんですか？調べてみたのですがわかりませんでした。 (会社のPCはVBAヘルプがインストールされていないのです…。) また、この場合はどのようにすればいいのでしょうか？ (やまびこ)
えええ～っ？
意味が・・・？
そのエラー、どげんかせんといけんの。＾＾
重複したデータはdicは上書きされます。
データが（tblで30000）有ってもそのうち50個が重複（同じデータ）があれば
dicに格納されるのは29950ですワ。
明日も仕事ででかけますし、もう今はでけあがってしもうて・・・。＾＾
この酔っぱらいどげんとせんといけんのぅ・・・。
（弥太郎）
追伸、明後日から空きますんで、どげんかしまひょ。
えっと、どんなコードでどの行がどんなエラーになりまっか？ （弥太郎）
弥太郎さん お返事遅くなりました。エラーになってしまったのは1シートの場合の方です。
が、実は先程解決しました。^^;
dicに格納しているのは基準となる分類コードなのですが、数値となっています。
Sheet1とSheet2を比較し、Sheet1にあってSheet2にないものをSheet2データの最終行に追加して、
Set dic = CreateObject("scripting.dictionary") ～としていました。
すると
x(dic(tbl(i, 1)), n) = tbl(i, n + 1)
の行のでエラーになりました。
エラー時の tbl(i, 1) は追加した分類コードでした。
そこで、昇順で並替をしてからだと問題がなくなりました。
Set dic = CreateObject("scripting.dictionary")の前にSortを追加しました。
下記がコードになります。
With Sheets("Sheet1").Range("H3")
.FormulaR1C1 = "=COUNTIF(Sheet2!C1,RC[-7])"
.AutoFill Destination:=Sheets("Sheet1").Range("H3:H" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row)
.AutoFilter Field:=7, Criteria1:="0"
End With
Sheets("Sheet1").Range("A3:A" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row). _
SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
'-------------------------------------------
'追加
Range("A2:E"&Range("A"&Rows.count).End(xlUp).Row).Sort Key1:=Range("A3"), Header:=xlYes
'-------------------------------------------
Set dic = CreateObject("scripting.dictionary")
With Sheets("Sheet2")
tbl = .Cells(3, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 2).Value
For i = 1 To UBound(tbl, 1)
dic(tbl(i, 1)) = i
Next i
End With
ReDim x(1 To dic.Count, 1 To 6)
With Sheets("Sheet1")
tbl = .Cells(3, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 1, 7)
For i = 1 To UBound(tbl, 1)
If dic.exists(tbl(i, 1)) Then
For n = 1 To UBound(x, 2)
x(dic(tbl(i, 1)), n) = tbl(i, n + 1) <---ここでエラーになりました
Next n
End If
Next i
End With
With Sheets("sheet2")
.Cells(3, 3).Resize(dic.Count, Columns.Count - 3).ClearContents
.Cells(3, 3).Resize(dic.Count, 6) = x
End With
Set dic = Nothing
dicに格納するものが数値の場合は並替えをしないとダメなんでしょうか？ (やまびこ)
なるほろ～、さういう塩梅になっとりましたか。 >dicに格納するものが数値の場合は並替えをしないとダメなんでしょうか？ いや、いや、そんな必要は全くありまへん。
考え方からすれば最初にSheet1のA列をdicでなぞります。
これはdic(tbl(i,1))=emptyでよろしいでせう。
次にSheet2へ移り
tbl = .Cells(3, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 2).Value
For i = 1 To UBound(tbl, 1)
If dic.exists(tbl(i, 1)) Then
dic.Remove tbl(i, 1)
End If
Next i
If dic.Count > 0 Then
.Cells(UBound(tbl, 1) + 3, 1).Resize(dic.Count) = Application.Transpose(dic.keys)
End If
dic.Removeall
tbl = .Cells(3, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 2).Value
For i = 1 To UBound(tbl, 1)
dic(tbl(i, 1)) = i
Next i
こんな塩梅にSheet1に有ってSheet2に無いデータをSheet2の最下行の下へ追加し、改め
てSheet2のデータをdictionaryに割り当ててやればよろしいかと思われます。
まぁ作業工程が増えるというだけの事ですワ。 （弥太郎）
弥太郎さん。お返事遅くなりました。 あけましておめでとうございます。年が明けてしまいました＾＾； やっと月初の仕事も落ち着き、登校できました。
なるほろ～。です。そういうこともできるんですね！ 勉強になります(^-^♪ありがとうございます！
で、タイトルにある「日付0値の置換」は、表示形式を「yyyy/m/d;;;@」に変えれば 見た目だけならＯＫだと気付きました＾＾； でもせっかくご指導いただきましたし、 過去ログみてもdictionaryは処理が早いようなので今後も活用していきたいです！ またお世話になることがあると思いますが、その時はよろしくお願いします。
隠れ弥太郎ファン（やまびこ）
コードの方が一段落ついたようですので・・・・ VLOOKUP関数で「0」となるのは、参照先のセル（VLOOKUP関数で返されるセル）が 空欄の時ですよね？
この時に一度「0」として於いて、後から「""」にするのではなく =IF(VLOOKUP($A3,A店!$A$C,COLUMN(B3),0)=0,"",VLOOKUP($A3,A店!$A$C,COLUMN(B3),0)) の様に「0の場合は"" それ以外の時はその値」と言う式にしておけば そもそも「0」にならないので、後から置換する必要もなく 問題は解決出来たかもしれません。
サンプルを見る限りでは =IF($B3=0,"",VLOOKUP($A3,A店!$A$C,COLUMN(B3),0)) でも良いのかもしれませんが・・・データの状況が良く分かっていないので どちらもご参考程度に。
(HANA)
HANAさん、ありがとうございます。 おっしゃる通りですね。 なぜそれに気が付かなかったのか…。 ご提示頂いたIF関数を使った回避方法は自分で使用した事もあったのですが…。 お粗末な質問でした。 でも個人的には勉強になりました。 この学校には心強い先生、先輩が多くて楽しいですね♪ ありがとうございます (やまびこ)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.