У меня есть электронная таблица с событием Worksheet_Change, которое вызывает подпрограмму в модуле.Код рабочей таблицы:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim itemType As String, material As String, size As Variant, rating As Variant, weldType As String
Dim rowNum, i, iMax, j As Double
If Target.Count > 1 Then Exit Sub
Disable_Slowdowns
'....code for other columns which is not triggered....
If Target.Column = 4 And Target.row > 4 Then
If Len(Target.Value2) > 0 Then AutoFill_By_PN Target
End If
Enable_Slowdowns
End Sub
Код для подпрограмм Enable_Slowdowns и Disable_Slowdowns, хранящихся в модуле:
Sub Disable_Slowdowns()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
End Sub
Sub Enable_Slowdowns()
If Application.EnableEvents = False Then Application.EnableEvents = True
If Application.ScreenUpdating = False Then Application.ScreenUpdating = True
If Application.Calculation = xlCalculationManual Then Application.Calculation = xlCalculationAutomatic
End Sub
Затем подпрограмма, выполняющая работу, называется AutoFill_by_PN (переменнаяобъявляется вне подпрограммы, внутри модуля, называется selectedPartIndex):
Public selectedPartIndex As Integer
Public Sub AutoFill_By_PN(ByVal rngPN As Range)
Dim vCell As Variant
Dim wb, costingWB As Workbook
Dim strTemp, PN, sName, sPrice, sSize, sType As String
Dim quotePosR, spacePosL, counter, i, k As Integer
Dim priceL, priceR As Variant
Dim dict As Object
Disable_Slowdowns
Set dict = CreateObject("Scripting.Dictionary")
PN = rngPN.Value2
Set costingWB = ActiveWorkbook
Set wb = Workbooks.Open(Filename:="Z:\Shared\Materials\Parts Book\New Parts Book - Official.xlsx", UpdateLinks:=1, ReadOnly:=1)
counter = 0
selectedPartIndex = -1
For Each vCell In wb.Sheets("PARTS BOOK").Range("$F$260:$F$3872")
With vCell
If InStr(1, .Value2, PN, vbTextCompare) > 0 Then
sName = "name" & counter
sType = "type" & counter
sPrice = "price" & counter
sSize = "size" & counter
dict.Add sName, .Value2
dict.Add sType, .Offset(, -2).Value2
quotePosR = InStr(1, .Value2, """", vbTextCompare)
If quotePosR > 0 Then
spacePosL = InStrRev(.Value2, " ", quotePosR, vbBinaryCompare)
strTemp = Evaluate(Replace(Mid(.Value2, spacePosL + 1, quotePosR - spacePosL - 1), "-", "+", compare:=vbTextCompare))
dict.Add sSize, strTemp
Else
dict.Add sSize, ""
End If
priceR = .Offset(, 3).Value2
priceL = .Offset(, 2).Value2
If IsNumeric(priceL) And IsNumeric(priceR) Then
If priceL - priceR <= 0 Then
dict.Add sPrice, priceR
Else
dict.Add sPrice, priceL
End If
ElseIf IsNumeric(priceL) Then
dict.Add sPrice, priceL
ElseIf IsNumeric(priceR) Then
dict.Add sPrice, priceR
Else
dict.Add sPrice, ""
End If
counter = counter + 1
End If
End With
Next vCell
If counter - 1 <= 0 Then
With rngPN
.Offset(, 3).Value2 = dict(sName)
.Offset(, 4).Value2 = dict(sType)
.Offset(, 6).Value2 = dict(sSize)
.Offset(, 13).Value2 = dict(sPrice)
End With
Else
For i = 0 To counter - 1
UF_PartSelection.LB_PartList.AddItem dict("name" & i), i
Next i
UF_PartSelection.Show
End If
If selectedPartIndex >= 0 Then
With rngPN
.Offset(, 3).Value2 = dict("name" & selectedPartIndex)
.Offset(, 4).Value2 = dict("type" & selectedPartIndex)
.Offset(, 6).Value2 = dict("size" & selectedPartIndex)
.Offset(, 13).Value2 = dict("price" & selectedPartIndex)
End With
End If
Enable_Slowdowns
End Sub
Идея состоит в том, что номер детали вводится в ячейку, затем выполняется поиск в книге деталей, а некоторые значения заполняются в других столбцах.,Важной частью является то, что иногда номер детали находится в тексте для нескольких деталей, и в этот момент отображается форма пользователя, позволяющая пользователю выбрать правильную деталь.Форма показывает, и весь задействованный код выполняется без ошибок до самой последней строки (буквально), когда код worksheet_change достигает «End Sub» - тогда я получаю сообщение, что «это действие сбросит проект».
Почему это происходит?Код для пользовательской формы ниже (поля заполняются правильно, а выбранный элемент записывается правильно)
Private Sub cmd_ok_Click()
Dim i, indexNo As Integer, vItem As Variant
indexNo = -1
For i = 0 To Me.LB_PartList.ListCount
If Me.LB_PartList.Selected(i) = True Then indexNo = i
Next i
If indexNo >= 0 Then capture_ListBox_Index indexNo Else capture_ListBox_Index -1
Unload Me
End Sub
И код для захвата выбора списка в том же модуле, что и в подпрограмме AutoFill_by_PN:
Public Sub capture_ListBox_Index(indexNo As Integer)
selectedPartIndex = indexNo
End Sub
Любая помощь приветствуется.Кажется, я не могу определить, какое действие конкретно вызывает сброс проекта - это происходит в строке «End Sub» в коде worksheet_change каждый раз, когда я выполняю код в режиме отладки.
[РЕДАКТИРОВАТЬ]: Я обнаружил, что код работает нормально, когда есть только один соответствующий номер детали.Это наводит меня на мысль, что это как-то связано с кодом пользовательской формы, потому что пользовательская форма отображается только при наличии нескольких совпадений.Кроме того, все значения ячеек корректно обновляются в соответствии с частью, выбранной пользователем в пользовательской форме, даже когда я получаю сообщение «Проект должен быть сброшен».Очень странно.
[EDIT 2]: я пытался запустить этот код в подпрограмме AutoFill_By_PN, но у меня все еще остается та же проблема:
If counter - 1 <= 0 Then
With rngPN
.Offset(, 3).Value2 = dict(sName)
.Offset(, 4).Value2 = dict(sType)
.Offset(, 6).Value2 = dict(sSize)
.Offset(, 13).Value2 = dict(sPrice)
End With
Else
Dim ui As New UF_PartSelection
For i = 0 To counter - 1
ui.LB_PartList.AddItem dict("name" & i), i
ui.LB_PartList.List(i, 1) = FormatCurrency(dict("price" & i), 2)
Next i
ui.Show
End If
[EDIT 3]: Спасибо за комментарий.После переписывания кода внутри блока «else», показанного выше, проблема решена!Код ниже:
Else
Dim ui As UF_PartSelection
Set ui = New UF_PartSelection
For i = 0 To counter - 1
ui.LB_PartList.AddItem dict("name" & i), i
ui.LB_PartList.List(i, 1) = FormatCurrency(dict("price" & i), 2)
Next i
ui.Show
End If