20170624xlVBA Regular Segmentation subtotals

Sub regexpsubtotal () ' Declare variable Dim Regex As Object ' regular object Dim Dic As Object ' Dictionary object Dim key As String ' keyword Dim Ite M as Double ' contents Dim Index As Long ' ordinal Dim text As String ' text Dim Mch As Object ' match set Dim onemch As Object ' match subkey Dim Rng as Range ' Cell object ' instantiation of regular object and Dictionary object Set Regex = CreateObject ("VBScript.RegExp") Set Dic = Createobje CT ("Scripting.Dictionary") with Regex. Global = True ' matching mode Zhejiang 4000 Anhui 19963.78 pattern = "([^\d\.] +) ([\d\.] +)"        . Pattern = pattern End with ' line-by-loop ' payment details for Index = 2 to Cells (Cells.Rows.Count, 1). End (Xlup). Row Text = Cells (Index, "A"). Text ' get literal set Mch = Regex.execute (text) ' Execute match for each onemch in Mch ' Loop match set Key = O        Nemch.submatches (0) ' Customer name Item = CDBL (onemch.submatches (1)) ' Payment amount dic (key) = DIC (key) + Item ' Subtotal Next onemch next Index ' quick transpose output subtotal content Set Rng = Range ("C1"). Resize (Dic.count, 2) Rng.Value = Application.WorksheetFunction.Transpose (Array (Dic.keys, Dic.items)) ' Release object Set Regex = Nothing Set Dic = Nothing Set Rng = NothingEnd Sub

　　

20170624xlVBA Regular Segmentation subtotals