Повторите часть моего подкатегория

Question

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

Делаю категорию для прямого дебета, ATM Выдача наличных денежных средств, а также дебетовые карты покупки в колонке D - Поиск D/D, C/L и POS соответственно в столбце B.

Я изменяя переменные, но каждый раз вводить и запускать один и тот же бит кода. Я чувствую, что должен быть способ сказать: «Запустите этот бит снова, но с Searchterm и Searchresult изменился!»

Я уверен, что кто-то более осведомлен, чем я мог бы помочь. Я уже использую sub, поэтому не могу вставить еще одну подпрограмму для ее запуска или функцию? И я уже зацикливаюсь, поэтому не знаю, как впишется еще один цикл?

Что вы хотите сделать? Как вы, наверное, догадались, что я совершенно новичок в этом, с небольшим знанием js в прошлом.

Sub OrganiseDefaultCategories() 
    ' 
    ' OrganiseDefaultCategories Macro 
    ' Categorise the Bank Statement Entries with Default inputs. Run this first. 
    ' 

    Dim FoundRange As Range, FirstAddress As String, Searchterm As Variant, Searchresult As Variant 

    Searchterm = "D/D" 
    Searchresult = "Direct Debit" 

     With Range("b:b") 
     Set FoundRange = .Find(What:=Searchterm, LookIn:=xlValues, _ 
     LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False) 
     FirstAddress = FoundRange.Address 
     Do 
     FoundRange.Offset(0, 2).Value2 = Searchresult 

     Set FoundRange = .FindNext(FoundRange) 
     Loop While Not FoundRange Is Nothing And FoundRange.Address <> FirstAddress 

     Searchterm = "C/L" 
    Searchresult = "ATM Cash Withdrawal" 


     Set FoundRange = .Find(What:=Searchterm, LookIn:=xlValues, _ 
     LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False) 
     FirstAddress = FoundRange.Address 
     Do 
     FoundRange.Offset(0, 2).Value2 = Searchresult 

     Set FoundRange = .FindNext(FoundRange) 
     Loop While Not FoundRange Is Nothing And FoundRange.Address <> FirstAddress 

     Searchterm = "POS" 
    Searchresult = "Debit Card Purchase" 


     Set FoundRange = .Find(What:=Searchterm, LookIn:=xlValues, _ 
     LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False) 
     FirstAddress = FoundRange.Address 
     Do 
     FoundRange.Offset(0, 2).Value2 = Searchresult 

     Set FoundRange = .FindNext(FoundRange) 
     Loop While Not FoundRange Is Nothing And FoundRange.Address <> FirstAddress 

    End With 


    End Sub 

Answer 1

Дайте этому выстрел:

Option Explicit 

Sub OrganiseDefaultCategories() 
    ' 
    ' OrganiseDefaultCategories Macro 
    ' Categorise the Bank Statement Entries with Default inputs. Run this first. 
    ' 

    Dim SearchTerm As String 
    Dim SearchResult As String 

    SearchTerm = "D/D" 
    SearchResult = "Direct Debit" 
    Finder SearchTerm, SearchResult 
    SearchTerm = "C/L" 
    SearchResult = "ATM Cash Withdrawal" 
    Finder SearchTerm, SearchResult 
    SearchTerm = "POS" 
    SearchResult = "Debit Card Purchase" 
    Finder SearchTerm, SearchResult 

End Sub 

Sub Finder(ByVal SearchTerm As String, ByVal SearchResult As String) 

    Dim FoundRange As Range 
    Dim FirstAddress As String 

    With Range("b:b") 
    Set FoundRange = .Find(What:=SearchTerm, LookIn:=xlValues, _ 
          LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
          MatchCase:=False, SearchFormat:=False) 
    If Not FoundRange Is Nothing Then 
     FirstAddress = FoundRange.Address 
     Do 
     FoundRange.Offset(0, 2).Value2 = SearchResult 
     Set FoundRange = .FindNext(FoundRange) 
     Loop While Not FoundRange Is Nothing And FoundRange.Address <> FirstAddress 
    End If 
    End With 

End Sub 

Я создал небольшую процедуру Finder, который принимает 2 параметра, SearchTerm и SearchResult, затем устанавливает переменные и вызывает Finder для каждой пары.

Я также объявил эти два как String вместо Variant. Вы действительно хотите использовать только Variant (некоторые функции требуют Variant), потому что это может привести к затруднению поиска ошибок, и это медленнее выполнить.

Я также немного изменили свой код, когда я извлек его в Finder процедуры, чтобы гарантировать, что мы проверяем результат .Find, чтобы гарантировать, что мы имеем что-то (т.е. Not ... is Nothing) перед тем пытается использовать его в любом случае. VBA делает не сделать короткое замыкание IF заявления, поэтому, если вы ничего не нашли с .Find, вы все равно получили бы ошибку, как вы ее первоначально написали.

Поздравляем с использованием .Find вместо того, чтобы перебирать все строки, сравнивая их! .Find будет значительно быстрее.

Answer 2

Extract общий код в Sub, а затем вызвать его:

Private Sub WhateverThisDoes(Searchterm As String, Searchresult As String) 
    Set FoundRange = .Find(What:=Searchterm, LookIn:=xlValues, _ 
          LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
          MatchCase:=False, SearchFormat:=False) 
    FirstAddress = FoundRange.Address 
    Do 
     FoundRange.Offset(0, 2).Value2 = Searchresult 

     Set FoundRange = .FindNext(FoundRange) 
    Loop While Not FoundRange Is Nothing And FoundRange.Address <> FirstAddress 
End Sub 

От вызывающей процедуры:

WhateverThisDoes "C/L", "ATM Cash Withdrawal" 
WhateverThisDoes "POS", "Debit Card Purchase" 
'...