BankDailyAuto 帮用户自动抽取数据

近期帮用户自动抽取数据写的宏。

'WXHWYD'This macro is for sorting data automatically only for Cummins casher'Stones create on 2017/6/16'Sub BankDailyAuto()Sub AutoBankDaily()    On Error GoTo ErrHandle    'stop screen-updating for user so program runs more fast    Application.ScreenUpdating = False        'total line number of DataSource    Dim TotalLineNum As Integer    'last index of DataSource    Dim LastRowNum As Integer    'vender name    Dim VendorName As String    'description    Dim Description As String    'each row of transaction type in DataSource sheet    Dim eachRowTranctionType As String    'each row of Additional Comments in DataSource sheet    Dim eachRowAdditionalComments As String    'each row of ORDP row index    Dim ORDPeachRowIndex As Integer    'each row of REMI row index    Dim REMIeachRowIndex As Integer    'each row of BEMN row index    Dim BEMNeachRowIndex As Integer    'lenth of each row 's Addition Comments    Dim LenOfAdditionComt As Integer        'select "DataSource" sheet    Sheets("DataSource").Select        LastRowNum = 1    Do While Range("A" & LastRowNum).Value <> ""        LastRowNum = LastRowNum + 1    Loop        'get total line number of DataSource    TotalLineNum = LastRowNum - 2        'judge if user pasted data in DataSource sheet    If TotalLineNum <= 0 Then    MsgBox "please paste data in DataSource Sheet!"    Exit Sub    End If    'get absolute value at column T    Range("T2").Select    ActiveCell.FormulaR1C1 = "=ABS(RC[-5])"    Selection.AutoFill Destination:=Range("T2:T" & (LastRowNum - 1))    'get absolute value at column U    Range("U2").Select    ActiveCell.FormulaR1C1 = "=ABS(RC[-5])"    Selection.AutoFill Destination:=Range("U2:U" & (LastRowNum - 1))        Range("T2:U" & (LastRowNum - 1)).Copy    Sheets("Result").Select    Range("I3").Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False            'clear temp data column T and column U in DataSource sheet    Sheets("DataSource").Select    Range("T2:" & "U" & (LastRowNum - 1)).Select    Selection.ClearContents        'copy "Post Date" to 'Date' in sheet result from sheet Datasource    Range("S2:" & "S" & (LastRowNum - 1)).Copy    Sheets("Result").Select    Range("A3").PasteSpecial xlPasteValues    Application.CutCopyMode = False    Sheets("DataSource").Select        'traverse datasource for each row    For DataSourceRowIndex = 1 To TotalLineNum       'get column "Mark" value       '1.If Transaction Type is TFR+ then insert into Type Mark as 'Collections' in destination sheet.       '2.If Transaction Type is TFR- and addition comments contain 'BENM' then insert into Type Mark as 'E-banking' in destination sheet.       '3.If Transaction Type is TFR- and addition comments don’t contain 'BENM' then insert into Type Mark as 'Auto-payment' in destination sheet.       'Column "W" is Vender Name       'Column "X" is Description       eachRowTranctionType = Range("M" & (DataSourceRowIndex + 1)).Value       eachRowAdditionalComments = Range("K" & (DataSourceRowIndex + 1)).Value       LenOfAdditionComt = Len(eachRowAdditionalComments)              If eachRowTranctionType = "TFR+" Then           'get column "Mark" value           Range("V" & (DataSourceRowIndex + 1)).Select           ActiveCell.FormulaR1C1 = "Collections"           '"ORDP"           If JG_ContainString(eachRowAdditionalComments, "ORDP") = "Y" Then               ORDPeachRowIndex = InStr(eachRowAdditionalComments, "/ORDP/")               '"REMI"               If JG_ContainString(eachRowAdditionalComments, "REMI") = "Y" Then                   REMIeachRowIndex = InStr(eachRowAdditionalComments, "/REMI/")                   Range("W" & (DataSourceRowIndex + 1)).Select                   ActiveCell.FormulaR1C1 = Mid(eachRowAdditionalComments, ORDPeachRowIndex + 6, REMIeachRowIndex - ORDPeachRowIndex - 6)                   Range("X" & (DataSourceRowIndex + 1)).Select                   ActiveCell.FormulaR1C1 = Mid(eachRowAdditionalComments, REMIeachRowIndex + 6)               Else                   Range("W" & (DataSourceRowIndex + 1)).Select                   ActiveCell.FormulaR1C1 = Mid(eachRowAdditionalComments, ORDPeachRowIndex + 6)               End If           Else               Range("W" & (DataSourceRowIndex + 1)).Select               ActiveCell.FormulaR1C1 = eachRowAdditionalComments           End If       End If       If eachRowTranctionType = "TFR-" Then           If JG_ContainString(eachRowAdditionalComments, "BENM") = "Y" Then               BENMeachRowIndex = InStr(eachRowAdditionalComments, "/BENM/")                                          '"REMI"                If JG_ContainString(eachRowAdditionalComments, "REMI") = "Y" Then                    REMIeachRowIndex = InStr(eachRowAdditionalComments, "/REMI/")                    Range("W" & (DataSourceRowIndex + 1)).Select                    ActiveCell.FormulaR1C1 = Mid(eachRowAdditionalComments, BENMeachRowIndex + 6, REMIeachRowIndex - BENMeachRowIndex - 6)                    Range("X" & (DataSourceRowIndex + 1)).Select                    ActiveCell.FormulaR1C1 = Mid(eachRowAdditionalComments, REMIeachRowIndex + 6)                                    Else                    Range("W" & (DataSourceRowIndex + 1)).Select                    ActiveCell.FormulaR1C1 = Mid(eachRowAdditionalComments, BENMeachRowIndex + 6)               End If                          'get column "Mark" value               Range("V" & (DataSourceRowIndex + 1)).Select               ActiveCell.FormulaR1C1 = "E-banking"           Else                              Range("W" & (DataSourceRowIndex + 1)).Select               ActiveCell.FormulaR1C1 = eachRowAdditionalComments                              'get column "Mark" value               Range("V" & (DataSourceRowIndex + 1)).Select               ActiveCell.FormulaR1C1 = "Auto-payment"           End If        End If    Next        Range("V2:V" & (LastRowNum - 1)).Copy    Sheets("Result").Select    Range("C3").Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False        Sheets("DataSource").Select    Range("W2:W" & (LastRowNum - 1)).Copy    Sheets("Result").Select    Range("F3").Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False        Sheets("DataSource").Select    Range("X2:X" & (LastRowNum - 1)).Copy    Sheets("Result").Select    Range("G3").Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False        'clear temp data column T and column U in DataSource sheet    Sheets("DataSource").Select    Range("V2:" & "X" & (LastRowNum - 1)).Select    Selection.ClearContentsErrHandle:    MsgBox "There is unexpected error .Please contact the administrator Stones Zhang ND936"End SubPublic Function JG_ContainString(SourceString As String, ContainString As String) As String    If InStr(SourceString, ContainString) <> 0 Then JG_ContainString = "Y" Else JG_ContainString = "N"End Function