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