Очистка кода VBA до ссылочного кода вместо его дублирования - PullRequest
Новая
       0

Очистка кода VBA до ссылочного кода вместо его дублирования

1 голос
/ 15 января 2020

Я закодировал форму для ввода информации о продукте, которая работает, и хотел бы ее очистить. В настоящее время для каждого подразделения продукта я скопировал и вставил один и тот же код, чтобы взять значения из формы и применить их к правильному листу подразделения. Я хотел бы, чтобы код встречался один раз, а затем ссылался на него в коде для 22 делений. Мне не удалось найти решение этой проблемы, вероятно, потому что я не знаю правильной терминологии.

Вот раздел, который я хотел бы исправить: 

Case "DIVISION 21 - FIRE SUPPRESSION"
Set ws = Sheets("Div-21")

LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value


Case "DIVISION 22 - PLUMBING"
Set ws = Sheets("Div-22")

LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value


Case "DIVISION 23 - HEATING VENTILATING AND AIR CONDITIONING"
Set ws = Sheets("Div-23")

LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value


Case "DIVISION 26 - ELECTRICAL"
Set ws = Sheets("Div-26")

LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value


Case "DIVISION 27 - COMMUNICATIONS"
Set ws = Sheets("Div-27")

LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value

Здесь это то, что я хотел бы сделать, если это возможно: 

[Refrence Code]=

LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value


Case "DIVISION 21 - FIRE SUPPRESSION"
Set ws = Sheets("Div-21")

[Refrence code]


Case "DIVISION 22 - PLUMBING"
Set ws = Sheets("Div-22")

[Refrence code]


Case "DIVISION 23 - HEATING VENTILATING AND AIR CONDITIONING"
Set ws = Sheets("Div-23")

[Refrence code]


Case "DIVISION 26 - ELECTRICAL"
Set ws = Sheets("Div-26")

[Refrence code]


Case "DIVISION 27 - COMMUNICATIONS"
Set ws = Sheets("Div-27")

[Refrence code]

Любая помощь будет оценена. Если возможно, объясните, пожалуйста, ясным и подробным образом, так как я все еще новичок в кодировании VBA и новичок в кодировании в целом.

Ответы [ 2 ]

2 голосов
/ 16 января 2020

Часть, которая изменяется - ws. Сохраните Select Case и затем переместите повторяющийся блок. 

    Case "DIVISION 21 - FIRE SUPPRESSION"
         Set ws = Sheets("Div-21")
    Case "DIVISION 22 - PLUMBING"
         Set ws = Sheets("Div-22")
    Case "DIVISION 22 - PLUMBING"
         Set ws = Sheets("Div-23")
    ...
    Case Else
         ' handle other cases, perhaps `Exit Sub`
End Select

' Now you need only one instance of the repetitive block
' You've got the right `ws` from above.

LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
... and so on

Если вы имеете дело с повторяющимся шаблоном DIVISION - ## - ...., то вы можете реорганизовать свой Select Case в отдельную функцию, которая анализирует имя листа. вместо перечисления всех возможностей, которые вы делаете в данный момент.

0 голосов
/ 16 января 2020

Желание не повторять код - отличная вещь. В этом случае вы можете просто сделать следующее: 

Case "DIVISION 21 - FIRE SUPPRESSION"
Set ws = Sheets("Div-21")

Case "DIVISION 22 - PLUMBING"
Set ws = Sheets("Div-22")

End Select

LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value

Но поскольку вы узнаете о том, как «обрезать код», я хотел бы затронуть также вызов подпрограммы с аргументами, например, так. 

Sub SheetSelect()

Dim ws as worksheet 

Case "DIVISION 21 - FIRE SUPPRESSION"
Set ws = Sheets("Div-21")
Call DoStuff(ws)

Case "DIVISION 22 - PLUMBING"
Set ws = Sheets("Div-22")
Call DoStuff(ws)

End Select
End Sub

Sub DoStuff(ws As WorkSheet)

LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value

End Sub

Я не знаю, что это за практика / лучшая политика, но я часто помещаю отдельные подпрограммы в отдельные модули, чтобы у меня не было модулей, которые были бы очень длинными. У меня также есть «основной» модуль, который вызывает только каждый саб, который что-то делает. Это позволяет мне комментировать подпрограммы для отладки и заново вводить их по очереди.

Например: 

Sub Main_Sub()

Call First_Task

'Call Second_Task ' Comment out "Second Task" for debugging till "First_Task" works as expected, this also allows for future debugging.

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...