基於包含關鍵字的文本字符串的Excel /分類宏（公式）

現在我花了幾天的搜索上下尋找解決方案。基於包含關鍵字的文本字符串的Excel /分類宏（公式）

我看到兩個線程，但這兩個線程都不是我正在尋找的內容，我承認，在VBA中不太好，我不能製作頭像或故事。

我有：我有4300行的銀行對賬單。有多列，但1是重要的 - 說明。這個描述可能包含很多東西，但通常有1個關鍵詞是關鍵的。大約96％可以自動化，3-4％只需手動寫入。

我想要什麼：

VBA宏將讀取列說明，將許多這樣的在Sheet2的名單有匹配的關鍵字，列的「關鍵詞」，然後在列類別寫（Sheet1中）的從Sheet2上的列類別中分配分類。

我迄今所做的：

我發現是爲我工作，並能夠用一個公式來居然重現的唯一的事情：

=IF(ISNUMBER(SEARCH("KEYWORD",[Description])),"OUTPUT","")

上述公式重複多但這會減慢並落後於一切。除了難以處理。

它的工作，但我需要更好的東西。所以 - >輸入宏。在這裏我迷路了。

我發現@JohnBustos的答案在這裏非常好： How to group excel items based on custom rules? 但我不是真的在爲我工作。

我發現Tomk Dallimore的答案是什麼，我需要或想要的： Categorizing bank transactions in Excel

，但我不能讓元首或故事到那裏怎麼走???他非常詳細，但我迷失在瞭解你的偉大複雜性上。

你能幫我嗎？

我附上一個非常簡單的例子，我正在說什麼。

http://1drv.ms/1Putpy5

注＃1 我founnd一個新的公式，我併入。「= IFERROR（LOOKUP（10^10，SEARCH（「」& KeywordTable [在關鍵字] &「」，「」& H29 &「」），KeywordTable [OUT-關鍵字]），「」）

但是，這也會影響CPU，因爲每次移動單元時都會計算它。我想如果我添加560個新行或者更好的話，它會拋出異常，然後用1個採樣移動表。臨時解決方案，但需要更復雜的東西。

*****可能是一個可怕的想法**** 爲了加快宏，宏等你在你的答案中提供的一個，是有可能使它像自動日期填料宏觀調控工作：私人小組Worksheet_Change（ByVal目標爲Excel。範圍）

With Target 
 
      If .Count > 1 Then Exit Sub 
 
      If Not Intersect(Range("B2:B100"), .Cells) Is Nothing Then 
 
       Application.EnableEvents = False 
 
       If IsEmpty(.Value) Then 
 
        .Offset(0, 3).ClearContents 
 
       Else 
 
        With .Offset(0, 3) 
 
         .NumberFormat = "dd mmm yyyy hh:mm:ss" 
 
         .Value = Now 
 
        End With 
 
       End If 
 
       Application.EnableEvents = True 
 
      End If 
 
     End With 
 
    End Sub

當然，我知道我要求的東西很奇怪，但如果這種情況發生，將是相當快的，非常有幫助的optimzing在其宏的執行速度大量的數據。現在，我有4500行來計算。在2個月內，這一數額將翻番。

來源

2015-12-02 Nallatheryth

根據你的excel文件，這段代碼的工作原理是：用這段代碼在3次中完成10'000行。

Sub test() 

Dim lastrow As Long, lastrow2 As Long 
Dim i As Integer, j As Integer 
Dim PatternFound As Boolean 

Call speedup 

lastrow = Sheets("Keywords").Range("A" & Rows.Count).End(xlUp).Row 
lastrow2 = Sheets("SOURCE DATA").Range("E" & Rows.Count).End(xlUp).Row 


For i = 4 To lastrow2 

PatternFound = False 

    j = 1 

Do While PatternFound = False And j < lastrow 

    j = j + 1 

      If UCase(Sheets("SOURCE DATA").Range("E" & i).Value) Like "*" & UCase(Sheets("Keywords").Range("A" & j).Value) & "*" Then 
       Sheets("SOURCE DATA").Range("F" & i).Value = Sheets("Keywords").Range("B" & j).Value 
       PatternFound = True 
      End If 

    Loop 

Next i 

Call normal 

End Sub 

Public Sub speedup() 

Application.ScreenUpdating = False 
Application.DisplayStatusBar = False 
Application.Calculation = xlCalculationManual 
Application.EnableEvents = False 
End Sub 

Public Sub normal() 

Application.ScreenUpdating = True 
Application.DisplayStatusBar = True 
Application.Calculation = xlCalculationAutomatic 
Application.EnableEvents = True 

End Sub

來源

2015-12-02 14:55:18 manu

我想我做錯了什麼。或者，也許我解釋得很糟糕。我輸入了代碼，但是它使得招募兵超出範圍。 – Nallatheryth

我已經從您的雲中下載了您的excel文件，並且完美地工作。請確保您的工作表名稱，這種情況是Sheet1和模式 – manu

您是否將代碼放在模塊中？ – manu

基於包含關鍵字的文本字符串的Excel /分類宏（公式）

回答

相關問題