vba 代码
来源:互联网 发布:mac os x 10.7.5 升级 编辑:程序博客网 时间:2024/05/21 17:28
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
- vba 代码
- VBA中的一些代码
- VBA实用代码拾零
- 加密 VBA 代码模块
- 经典Excel VBA代码
- 经典Excel VBA代码
- VSTO运行VBA代码
- Excel VBA代码学习
- VBA入门代码尝试。
- 调试Excel VBA代码
- VBA代码收集
- Excel VBA 代码笔记
- vba常用代码
- VBA代码学习
- VBA代码拆分excel
- VBA代码排版工具
- VBA - 封装我们的VBA代码
- 【VBA研究】VBA代码的存放位置
- Repository模式
- Suse Linux系统下JAVA AWT界面乱码问题
- 腾讯通RTX无法正常拉取组织架构的解决方法
- 工作一年了,还真不知道自己到底做的是硬件测试还是软件测试
- 搭建掌上游戏开发环境
- vba 代码
- dnf私服出来;了
- VC++开发BHO插件——定制你的浏览器
- 页面时钟倒计时
- 08 Window对象
- RedhatLinux HowTos - network and version relevant
- 函数的参数里面的数组参数是引用类型的
- 09 Document对象
- 技术总监谈好的程序员如何写代码