vba 代码

Sub make_vbeecome_importdata()

   
   
    Sheets("out").Select
    Cells.Select
    Selection.ClearContents
    Selection.Interior.ColorIndex = xlNone
    Range("A1").Select
   
    line_no = 1
    Do While Range("input!E" & line_no).Text <> ""
       
        Range("out!A" & line_no) = Range("input!A" & line_no)
        Range("out!B" & line_no) = Range("input!B" & line_no)
        Range("out!C" & line_no) = Range("input!C" & line_no)
        Range("out!D" & line_no) = Range("input!D" & line_no)
        'Range("out!E" & line_no) = Range("input!E" & line_no)
        Range("out!F" & line_no) = Range("input!F" & line_no)
        Range("out!G" & line_no) = Range("input!G" & line_no)
        Range("out!H" & line_no) = Range("input!H" & line_no)
        Range("out!I" & line_no) = Range("input!I" & line_no)
        Range("out!J" & line_no) = Range("input!J" & line_no)
        Range("out!K" & line_no) = Range("input!K" & line_no)
        Range("out!L" & line_no) = Range("input!L" & line_no)
        Range("out!M" & line_no) = Range("input!M" & line_no)
        Range("out!N" & line_no) = Range("input!N" & line_no)
        Range("out!O" & line_no) = Range("input!O" & line_no)
        Range("out!P" & line_no) = Range("input!P" & line_no)
        Range("out!Q" & line_no) = Range("input!Q" & line_no)
        Range("out!R" & line_no) = Range("input!R" & line_no)
        Range("out!S" & line_no) = Range("input!S" & line_no)
        Range("out!T" & line_no) = Range("input!T" & line_no)
        Range("out!U" & line_no) = Range("input!U" & line_no)
        Range("out!V" & line_no) = Range("input!V" & line_no)
        Range("out!W" & line_no) = Range("input!W" & line_no)
       
        If line_no = 1 Then
            Range("out!E" & line_no) = Range("input!E" & line_no)
        Else
           
            strtext = Range("input!E" & line_no).Text   '  usa,97
           
            If InStr(1, strtext, ",") > 0 Then
                'name code all ok
                Dim arrTmp() As String
                arrTmp() = Split(strtext, ",")
               
                i = UBound(arrTmp())
                strtmp = arrTmp(i)
                If IsNumeric(strtmp) Then
                    Range("out!E" & line_no) = strtext
                Else
                    'name to code   ---------
                    Range("out!E" & line_no) = getCode(strtext)
                End If
                   
               
            ElseIf IsNumeric(strtext) Then
                'code to name
                Dim codename As String
                codename = getName(strtext)
                If codename = "" Then
                    Range("out!E" & line_no) = strtext
                    Range("out!E" & line_no).Select
                    With Selection.Interior
                        .ColorIndex = 3
                        .Pattern = xlSolid
                    End With
                Else
                    Range("out!E" & line_no) = codename & "," & strtext
                End If
            Else
                'name to code
                Dim code As String
                code = getCode(strtext)
                If code = "" Then
                    Range("out!E" & line_no) = strtext
                    Range("out!E" & line_no).Select
                    With Selection.Interior
                        .ColorIndex = 3
                        .Pattern = xlSolid
                    End With
                Else
                    Range("out!E" & line_no) = strtext & "," & code
                End If
            End If
       End If
       
       line_no = line_no + 1
    Loop
   
End Sub


Function getName(strcode)
    'input 977  return  nepel
    Dim ws As Worksheet
    Dim rgsearchin As Range
    Dim rgfind As Range
    Dim sfirstfound As String
    Dim bcontinue As Boolean
    Dim codename As String
   
    codename = ""
    bcontinue = True
    Set ws = Sheets("code")
   
    Set rgsearchin = getsearchrange(ws, 2)
    Set rgfind = rgsearchin.Find(what:=strcode, LookIn:=xlValues, LookAt:=xlWhole)
    If Not rgfind Is Nothing Then
        sfirstfound = rgfind.Address
        codename = ws.Cells(rgfind.Row, 1)
    End If
   
    'Do Until rgfind Is Nothing Or Not bcontinue
    '    Set rgfind = rgsearchin.FindNext(rgfind)
    '    If rgfind.Address = sfirstfound Then
    ''        bcontinue = False
    '    End If
    'Loop
   
    Set rgsearchin = Nothing
    Set rgfind = Nothing
    Set ws = Nothing
       
    getName = codename
   
End Function


Function getCode(strName)
    'input nepel return 977
    Dim code As String
    Dim ws As Worksheet
    Dim rgsearchin As Range
    Dim rgfind As Range
    Dim sfirstfound As String
    Dim bcontinue As Boolean
   
    code = ""
    bcontinue = True
    Set ws = Sheets("code")
   
    Set rgsearchin = getsearchrange(ws, 1)
    Set rgfind = rgsearchin.Find(what:=strName, LookIn:=xlValues, LookAt:=xlWhole)
    If Not rgfind Is Nothing Then
        'find
        sfirstfound = rgfind.Address
        code = ws.Cells(rgfind.Row, 2)
    Else
        'no find
        arrTmp = Split(strName, " ")
        strtmp = arrTmp(0)
        Set rgfind = rgsearchin.Find(what:=strtmp, LookIn:=xlValues, LookAt:=xlWhole)
        If Not rgfind Is Nothing Then
            'find
            sfirstfound = rgfind.Address
            code = ws.Cells(rgfind.Row, 2)
        End If
    End If
   
    Set rgsearchin = Nothing
    Set rgfind = Nothing
    Set ws = Nothing
   
    getCode = code
End Function


Private Function getsearchrange(ws As Worksheet, col As Integer) As Range
    Dim ilastrow As Long
    ilastrow = ws.Cells(65535, 1).End(xlUp).Row
    Set getsearchrange = ws.Range(ws.Cells(1, col), ws.Cells(ilastrow, col))
End Function