Я сделал несколько комментариев по предоставленному коду. Возможно, вы сможете использовать отредактированный код, но даже если вы не можете, он показывает некоторые полезные вещи. Естественно, я не запускал код, потому что у меня нет доступа к исходной книге.
Код для реализации вспомогательной переменной и нумерации, о котором я упоминал в своем комментарии, следует за комментариями к предоставленному коду.
Новичок в VBA?
Если вы новичок в программировании на VBA, то вы можете сделать четыре вещи, которые сделают вашу жизнь менее болезненной.
Получение помощи. В VBA Ide, если вы поместите курсор на ключевое слово VBA или объект Office и нажмете F1, вы получите страницу справки MS для этого ключевого слова / объекта.
Опция Put указывается явно в верх каждого модуля / класса
Перед запуском любого кода создайте проект Dugbug.Compile, чтобы убедиться, что все легко обнаруживаемые синтаксические ошибки были устранены
Установите fantasti c и бесплатное дополнение RubberDuck для VBA, которое дает вам множество действительно полезных инструментов (правильное переименование, рефакторинг, форматирование кода и т. Д. c) специально для обучения, которое вы получите от утилиты Code Ispections , Это действительно очень важный шаг. http://rubberduckvba.com/
Я обычно не использую Excel, поэтому могут быть советы, которые могут быть предоставлены другими, которые будут лучше, чем любой мой совет ниже относительно Excel
Stati c Функция
Вы объявили функцию как stati c с неявным возвращаемым значением Variant, но фактически ничего не возвращаете из функции.
Ключевое слово stati c сохраняет значения всех переменных, локальных для функции / подпрограммы, но таким образом, что к ним можно получить доступ, только если вы на самом деле находитесь в функции / или подпрограмме. Я подозреваю, что вы действительно намерены использовать переменную Inputs для хранения информации для использования в другом месте. Как следствие, у меня есть
Инкапсулированные входы определенного пользователем типа в области видимости модуля и добавленный код для обеспечения доступа к входам извне модуля. Для этого я удалил Stati c из объявления функции, изменил его на подмену объявления переменной Inputs из функции в область действия модуля в UDT. Ссылки, приведенные ниже, помогут понять UDT и то, что мы делаем с переменной s.
изменили функцию на подпрограмму, поскольку теперь мы заполняем переменную области видимости модуля, а не возвращаем значение
удалило ключевое слово stati c, потому что мы хотим сохранить только входы, а не каждую переменную в подпрограмме (но я признаю, что нам также может потребоваться сделать то же самое для данных из myInputWs
'https://docs.microsoft.com/en-us/office/vba/Language/Reference/user-interface-help/type-statement' https://rubberduckvba.wordpress.com/2018/04/25/private-this-as-tsomething/
Option Explicit
Private Type State
Components() As Components
End Type
Private s As State
Public Function Components() As Variant
Components = s.Components
End Function
Public Property Set Component(ByVal Index As Long, ByVal Value As Variant)
On Error Resume Next
Dim dummy As Variant
dummy = s.Components(0)
If Err.Number <> 0 Then
Err.Raise 9, "ModuleName:Set Item: s.Inputs has not been initialised£"
End If
On Error GoTo 0
s.Components(Index) = Value
End Property
Public Property Get Component(ByVal Index As Long) As Variant
On Error Resume Next
Dim dummy As Variant
dummy = s.Components(0)
If Err.Number <> 0 Then
Err.Raise 9, "ModuleName:Get Item: s.Inputs has not been initialised£"
End If
On Error GoTo 0
Component = s.Components(Index)
End Property
Public Sub SetComponentProperties()
Dim myPropsWs As Excel.Worksheet
Set myPropsWs = ActiveWorkbook.Worksheets.[_Default]("Component Properties")
Dim myInputWs As Excel.Worksheet
Set myInputWs = ActiveWorkbook.Worksheets.[_Default]("Input")
Не кодируйте то, что Excel работает лучше
У вас, похоже, есть участок кода, в котором подсчитываются непустые ячейки в диапазоне. Совет здесь заключается в том, что если вы не делаете что-то очень конкретное c, лучше разрешить Excel ( или другое офисное приложение) сделать тяжелую работу. В вашем случае вы, вероятно, можете использовать WorksheetFunction для вызова функции CountA Excel. Использование функции рабочего листа позволяет нам свернуть
Dim i As Integer
i = 1
Dim j As Integer
j = 1
Dim k As Integer
Dim Input_Conc As Range
Set Input_Conc = Worksheets("Input").Range("D3:D52")
Do ' Counts number of Components
If IsEmpty(Input_Conc(i)) = False Then
j = j + 1
End If
i = i + 1
Loop Until IsEmpty(Input_Conc(i)) = True
ReDim Inputs(j)
до
Dim myNonEmptyCells As Long
myNonEmptyCells = Application.WorksheetFunction.CountA(myInputWs.Range("D3:D52"))
ReDim s.Components(myNonEmptyCells)
Я В приведенном выше коде я использовал промежуточную переменную для сбора количества ячеек, поскольку это облегчает отладку (например, при пошаговом выполнении кода с использованием F8)
Повторное использование переменных и бесполезное именование
Вы объявили переменные i и j и использовали их в двух разных сценариях ios в своей функции. Это рецепт боли и guish. Я бы настоятельно рекомендовал не использовать переменные, какими бы умными и удобными они ни казались. Я также рекомендовал бы не использовать имена как я и j. Используйте правильные осмысленные имена, чтобы через шесть месяцев у вас или у следующей несчастной души, чтобы обновить код, был лучший шанс понять, что делает код.
У вас также есть неиспользуемая переменная Source_Row, которая соответствует свойству класса Components .Source_Row. Опять же, это рецепт ie от боли и guish. Я бы использовал более информативное имя для «Source_Row», например SourceRowInExcel. Также стоит отметить, что эта переменная фактически не используется нигде в подпрограмме, что является еще одной трудной точкой для будущих рецензентов.
Для каждого против Для
Основной л oop вашей функции выполняет итерации по массиву Inputs, но использует только переменную управления l oop (повторно использованную i) в качестве индекса. В таком случае мы можем упростить код, используя 'For Each' l oop. Для 'For Each' l oop управляющая переменная ДОЛЖНА быть вариантом или типом объекта. Я часто устанавливаю отдельную индексную переменную, которую нужно увеличивать до +1, чтобы получить преимущества «Для каждого».
Dim myInput как вариант для каждого myInput In s.Inputs Next
Облегчение чтения
У вас явно есть gr asp структуры 'With', но вы, вероятно, обнаружили, что эта структура может расстраивать, как обычно, вы хотите два Структуры «С» для параллельной работы. Следовательно, лучше избегать структуры «С», за исключением простых случаев, и вместо этого использовать локальные переменные для предоставления необходимых ярлыков
Dim myPropsWs As Excel.Worksheet
Set myPropsWs = ActiveWorkbook.Worksheets.[_Default]("Component Properties")
Dim myInputWs As Excel.Worksheet
Set myInputWs = ActiveWorkbook.Worksheets.[_Default]("Input")
Ненужная работа
Do l oop имеет тест для пустой ячейки в конце l oop. Это означает, что если .Cas пуст, вы по-прежнему заполняете значения 58 компонентов до выхода из подпрограммы. Более разумным подходом было бы проверить пустую ячейку в начале l oop и затем выполнить любые необходимые настройки после l oop и перед выходом из сабвуфера.
Dim j As Long: j = 0
Dim myInput As Variant
Dim k As Long: k = 3
Do Until IsEmpty(myInputWs.Cells.Item(k, 3))
For Each myInput In s.Components
Set myInput = New Components
' The addition of code to deal with data from myInputWs is left as an exercise for the reader
myInput.Cas = myInputWs.Cells.Item(k, 3)
myInput.Concentration = myInputWs.Cells.Item(k, 4)
myInput.Name = myInputWs.Cells.Item(k, 2)
myInput.Source_Row = Application.WorksheetFunction.Match(myInput.Cas, myPropsWs.Range("A3:A1000"), 0)
myInput.ComponentProperties = myPropsWs.Range(myPropsWs.Cells.Item(myInput.Source_Row, 2), myPropsWs.Cells.Item(myInput.Source_Row, 60)).Value2
Next
j = j + 1
Loop
В качестве альтернативы вы можете иметь бесконечное l oop с предложением выхода, основанным на самом l oop
Do
For Each myInput In s.Inputs
Set myInput = New Components
myInputs.Cas = myInputWs.Cells(k, 3)
If IsEmpty(myInputWs.Cells(k, 3)) Then
' any other needed action before exiting
Exit Function
End If
myInput.Concentration = myInputWs.Cells(k, 4)
myInput.Name = myInputWs.Cells(k, 2)
myInput.Source_Row = Application.Match(myInput.Cas, myPropsWs.Range("A3:A1000"), 0)
myInput.ComponentProperties = myPropsWs.Range(myPropsWs.Cells(myInputs.Source_Row, 2), myPropsWs.Cells(myInputs.Source_Row, 60)).Value2
Next
Loop
Если бы не j = j + 1 строка, мы могли бы вообще обойтись без Do l oop, но, поскольку j не дает нам абсолютно никакой подсказки относительно того, что вы делаете в тот момент, я оставил это.
Кроме того, в качестве отступления , в исходном коде у вас есть две строки, присваивающие разные значения одному и тому же свойству Components. Имя?.
.Name = Worksheets("Input").Cells(k, 2)
.Source_Row = Application.Match(Inputs(i).CAS, Worksheets("Component Properties").Range("A3:A1000"), 0)
.Name = Worksheets("Component Properties").Cells(Inputs(i).Source_Row, 2)
Для простоты использования код для замены вашей функции приведен ниже
Option Explicit
Private Type State
Components() As ScriptingDictionary
End Type
Private s As State
Public Function Components() As Variant
Components = s.Components
End Function
Public Property Set Component(ByVal Index As Long, ByVal Value As Variant)
If UBound(s.Components) = -1 Then
Err.Raise 9, "ModuleName:Let Item: s.Inputs has not been initialised£"
End If
s.Components(Index) = Value
End Property
Public Property Get Component(ByVal Index As Long) As Variant
On Error Resume Next
If UBound(s.Components) = -1 Then
Err.Raise 9, "ModuleName:Get Item: s.Inputs has not been initialised£"
End If
Component = s.Components(Index)
End Property
Public Sub SetComponentProperties()
Dim myPropsWs As Excel.Worksheet
Set myPropsWs = ActiveWorkbook.Worksheets.[_Default]("Component Properties")
Dim myInputWs As Excel.Worksheet
Set myInputWs = ActiveWorkbook.Worksheets.[_Default]("Input")
Dim myNonEmptyCells As Long
myNonEmptyCells = Application.WorksheetFunction.CountA(ActiveWorkbook.Worksheets.[_Default]("Input").Range("D3:D52"))
ReDim s.Components(myNonEmptyCells)
Dim j As Long: j = 0
Dim myInput As Variant
Dim k As Long: k = 3
Do Until IsEmpty(myInputWs.Cells.Item(k, 3))
For Each myInput In s.Components
Set myInput = New Components
' The addition of code to deal with data from myInputWs is left as an exercise for the reader
myInput.Cas = myInputWs.Cells.Item(k, 3)
myInput.Concentration = myInputWs.Cells.Item(k, 4)
myInput.Name = myInputWs.Cells.Item(k, 2)
myInput.Source_Row = Application.WorksheetFunction.Match(myInput.Cas, myPropsWs.Range("A3:A1000"), 0)
myInput.ComponentProperties = myPropsWs.Range(myPropsWs.Cells.Item(myInput.Source_Row, 2), myPropsWs.Cells.Item(myInput.Source_Row, 60)).Value2
Next
j = j + 1
Loop
' Do
'
'
' For Each myInput In s.Inputs
'
' Set myInput = New Components
' myInputs.Cas = myInputWs.Cells(k, 3)
' If IsEmpty(myInputWs.Cells(k, 3)) Then
'
' ' any other needed action before exiting
' Exit Function
'
' End If
' myInput.Concentration = Worksheets("Input").Cells(k, 4)
' myInput.Name = myInputWs.Cells(k, 2)
' myInput.Source_Row = Application.Match(myInput.Cas, myPropsWs.Range("A3:A1000"), 0)
'
' myInput.ComponentProperties = myPropsWs.Range(myPropsWs.Cells(myInputs.Source_Row, 2), myPropsWs.Cells(myInputs.Source_Row, 60)).Value2
'
' Next
' ' I've no idea what the line below is doing.
' j = j + 1
'
' Loop
End Sub
Некоторый код для проверки вышеуказанного обновления.
Sub TestComponentsUpdate()
Dim ThisComponents As Components
Set ThisComponents = New Components
ThisComponents.Item(BTU) = 42
Dim myProperty As Variant
myProperty = ThisComponents.Item(Amine)
Dim myItem As ComponentPropertyEnum
For myItem = ComponentPropertyEnum.AMCRN To ComponentPropertyEnum.VP50_Kpa
Debug.Print "ComponentProperty Enum:Value", myItem; ":"; ThisComponents.Item(myItem)
Next
Dim myProp As Variant
For Each myProp In ThisComponents.Items
Debug.Print "ComponentProperty Value", myProp
Next
' The code above was located in Module2 when I updated it, Replace Module2 with your own Module name
Dim myProp2 As Variant
For Each myProp2 In Components(4).Items
Debug.Print "Components 4 ComponentsProperty Value", myProp2
Next
End Sub
Переменная Backing и перечисление
Код ниже предполагает, что у вас есть доступ к коду в Компоненте class.
Добавьте приведенный ниже код к коду класса компонента. Объявления Enum, Type и переменные должны go перед первой подпрограммой / функцией.
Этот код позволит вам заменить код из
.Name = Worksheets("Component Properties").Cells(Inputs(i).Source_Row, 2)
to
.Amine = Worksheets("Component Properties").Cells(Inputs(i).Source_Row, 60)
одной строкой, как в код выше.
Option Explicit
'Enumerations and Type declarations go before the
' first sub/function in a module or class
Public Enum ComponentProperties
'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/enum-statement
ComponentName
MW
VP50_Kpa
Tki
L_Den
mL_mol
BP
FP
Refrigerated
Pyrophoric
GUP
FG
LG
FL
OG
SC
EI
RS
SS
GCM
Carcinogen
RH
Store
STOSE
EHA
EHC
ODS
Toxicity
AMCRN
Tci
LC50
S1S
S2S
Comp_F
SL_Hi
SL_Lo
Reactive
BTU
LEL
UEL
MOC
CF
KK
Prop_65
C_no
H_no
O_no
S_no
Si_no
B_no
N_no
P_no
F_no
Cl_no
Br_no
I_no
Halogen_no
Silane
Amine
End Enum
' A user defined Type is used to hold a backing variable
' (otherwise known as private member)
Private Type State
Data As Variant
End Type
Private s As State
' The property which allows an array to be written to or obtained from a Component object
' its assumed that the array will come from a spreadsheet
' e.g. columns 2 to 60 of the Component Properties spreadsheet
' it also means that we can retries the properties as an array so that we can iterate overthem if required.
Public Property Set Data(ByVal PropertiesArray As Variant)
s.Data = PropertiesArray
End Property
Public Property Get Data() As Variant
Data = s.Data
End Property
' The Item Property (if Item hasn't already been used in the component object)
' allows reading and writing of individual properties
Public Property Let Item(ByVal Value As Variant, ByVal Index As ComponentProperty)
s.Data(Index) = Value
End Property
Public Property Get Item(ByVal Index As ComponentProperty) As Variant
Item = s.Data(Index)
End Property
В исходном коде мы не знаем, что происходит для каждого из 58 используемых свойств. Если свойства (такие как .Refrigerated) хранят только данные и не выполняют никакой проверки, то каждое свойство может быть заменено соответствующим .Item (перечисление), например .Item (Refrigerated).
Если каждое свойство выполняет проверка перед сохранением полученного значения, затем вам нужно будет реализовать сквозное свойство для каждого свойства в классе Components. Если это так, дайте мне знать, и я обновлю ответ.
Если у вас есть какие-либо вопросы по поводу приведенного выше кода, пожалуйста, задавайте их, но на самом деле мы должны перенести такое обсуждение в чат-комнату.