私は、次のコード行に問題を抱えている:エクセル - 辞書オブジェクトの奇妙な行動
Set DICT = RowMap(Range(Workbooks("A").Sheets(1).Cells(ITEM_NO_ROW, _
ITEM_NO_COLUMN), Workbooks("A").Sheets(1).Cells(ITEM_NO_ROW + 1, ITEM_NO_COLUMN).End(xlDown)))
このコードはRowMapを呼び出します。私は、RowMapの "End Function"にブレークを入れ、ウォッチウィンドウでrvとRowMapの数をチェックします。両方のカウントは、84でなければなりません。しかし、私がメインルーチンに連れて行って、DICTのカウントをチェックするF8を押すとすぐに、それは84でなく85です。
DICTはRowMapまたはrvとまったく同じであってはなりませんか?なぜDICTの数が1つ増えたのですか?どのコード行でそれができますか?私は完全に失われています。
この情報が役立つかどうかわかりません。上記のSet DICTラインは、 "For each in rng"ループで包まれ、DICTの最後に追加されるセルです。
ご協力いただきますようお願い申し上げます。
Function RowMap(rng1 As Range) As Object
'store item no and price in dictionary
Dim rv As Object
Dim c As Range
Dim v As long
On Error Resume Next
Set rv = Nothing
Set rv = CreateObject("scripting.dictionary")
For Each c In rng1.Cells
v = c.Value
If Not rv.Exists(v) Then
rv.Add v, c.Offset(0, 4) 'add item no and price
Else
MsgBox "Duplicate value detected in " & Book_Name & "!"
Exit For
End If
Next c
Set RowMap = rv
End Function
For Each wk In Application.Workbooks
If Left(wk.Name, 6) = "All FE" Then
ERROR_Sheet_No = ERROR_Sheet_No + 1
For Each sh In wk.Sheets
Set Report_Last_Cell = sh.Cells(5000, 3).End(xlUp)
'sort the data by group code
Set rng = sh.Range(sh.Cells(4, 1), Report_Last_Cell.Offset(0, 4))
rng.Sort key1:=sh.Cells(4, 4), order1:=xlAscending, Header:=xlNo
Set rng = sh.Range(sh.Cells(4, 3), Report_Last_Cell)
For Each cell In rng
If cell.Value <> "LAVENDER" And cell.Value <> "CLOSED" And cell.Value <> "VOID" And cell.Value <> "NO SALE" And _
InStr(cell.Value, "DISCOUNT") = 0 And InStr(cell.Value, "DEPOSIT") = 0 And Len(cell) <> 0 Then
Group_Code = cell.Offset(0, 1).Value
If Group_Code <> Old_Group_Code Then 'open the PHOTO_QUOTE file
'close the old PHOTO_QUOTE file first
On Error Resume Next
Workbooks(File_Prefix & Old_Group_Code & ".xlsx").Close
On Error GoTo 0
'open the PHOTO QUOTE file if exists
If Len(Dir(Flower_Path & File_Prefix & Group_Code & ".xlsx")) <> 0 Then 'if file is found
Workbooks.Open Flower_Path & File_Prefix & Group_Code & ".xlsx"
Photo_Quote_Book_Name = File_Prefix & Group_Code & ".xlsx"
On Error Resume Next
DICT.RemoveAll
Set DICT = Nothing
Set DICT = RowMap(Range(Workbooks(Photo_Quote_Book_Name).Sheets(1).Cells(PHOTO_QUOTE_ITEM_NO_ROW, _
PHOTO_QUOTE_ITEM_NO_COLUMN), Workbooks(Photo_Quote_Book_Name).Sheets(1).Cells(PHOTO_QUOTE_ITEM_NO_ROW + 1, PHOTO_QUOTE_ITEM_NO_COLUMN).End(xlDown)))
On Error GoTo 0
'check if ITEM NO exists
If Not DICT.Exists(cell.Value) Then
Copy_to_ERROR_sheet sh.Name, ERROR_Sheet_lastrow, 0, 0, 255
'check if price matches
ElseIf cell.Offset(0, 3).Value <> DICT(cell.Value) Then
Copy_to_ERROR_sheet sh.Name, ERROR_Sheet_lastrow, 0, 255, 0
End If
Else 'if the PHOTO_QUOTE file doesn't exist, copy shop, date, voucher no, item no, price to
' ERROR_BOOK_NAME and change color to red
Copy_to_ERROR_sheet sh.Name, ERROR_Sheet_lastrow, 255, 0, 0
End If 'If Len(Dir(Flower_Path & File_Prefix & Group_Code & ".xlsx")) <> 0 Then
Old_Group_Code = Group_Code
End If ' If Group_Code <> Old_Group_Code Then
End If 'If cell.Value <> "LAVENDER" And cell.Value <> "CLOSED" And cell.Value <> "VOID" And cell.Value <> "NO SALE" And _
InStr(cell.Value, "DISCOUNT") = 0 And InStr(cell.Value, "DEPOSIT") = 0 And Len(cell) <> 0 Then
Next 'For Each cell In rng
Next 'For Each sh In wk
End If 'If Left(wk.Name, 6) = "All FE" Then
Next 'For Each wk In Application.Workbooks
Close_PHOTO
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub 'Check_Price
On Error Resume Nextが必要なものは何もありません。そのため、それを削除してエラーを知らせるようにします。呼び出し側のサブステップでカウントを取得している場所を正確に表示すると便利です。その手続きのいくつかの関連する行が役に立ちます –
私はこのコードを実行していますが、テストではRowMapと 'DICT'、投稿されていないあなたのコードには何がありますか? 'rng1'の中に数値ではないものがありますか? –
このコードには、型の不一致などのエラーが数多くある可能性がありますが、エラー値、ゼロ値と最高値のマージされたセル、キーの値としての範囲がカウントミスマッチであることは私が再現できないものです。 – cyboashu