 |
| 等 级：资深长老 |
| 经 验 值：30171 |
| 魅 力 值：138 |
| 龙 币：15376 |
| 积 分：16750.2 |
| 注册日期：2003-06-03 |
| |
|
|
|
VBA搞定
Sub test()
Dim myWorkbook As Workbook
Dim sheet
Response = MsgBox("开始工作？", vbYesNo + vbCritical)
If Response = vbYes Then ' 用户按下“是”。
Set myWorkbook = Workbooks("Book1.xls")
For Each sheet In myWorkbook.Sheets
'MsgBox sheet.Name + ";" + CStr(sheet.UsedRange.Rows.Count)
For i = 1 To sheet.UsedRange.Rows.Count
Dim temp
temp = sheet.Cells(i, 1).Text
temp = Trim(getStr(temp))
If (Len(temp) > 0) Then
Dim findcode
findcode = FindDimension(temp)
sheet.Cells(i, 40).Value = findcode
'If Len(findcode) > 0 Then
'MsgBox sheet.Name + ":" + temp + "!!!!" + findcode
'End If
End If
Next
Next
MsgBox "很快吧！"
End If
End Sub
Function FindDimension(ByVal myMember As String)
Dim cFind As Range
Dim re As String
Dim myWorkbook As Workbook
Dim sheet
Set myWorkbook = Workbooks("erp编码.xls")
For Each sheet In myWorkbook.Sheets
'For i = 1 To 1
'Set sheet = myWorkbook.Sheets(1)
Set cFind = sheet.Cells.Find(myMember, LookIn:=xlValues, LookAt:=xlWhole)
If Not cFind Is Nothing Then
Dim code As Range
Set code = sheet.Cells(cFind.Row, 2)
temp = sheet.Name + ":" + code.Text
re = temp
sheet.Cells(cFind.Row, 7).Value = 1
firstAddress = cFind.Address
Do
Set cFind = sheet.Cells.FindNext(cFind)
If Not cFind Is Nothing And cFind.Address <> firstAddress Then
'Dim code As Range
Set code = sheet.Cells(cFind.Row, 2)
temp = sheet.Name + ":" + code.Text
re = re + ";" + temp
sheet.Cells(cFind.Row, 7).Value = 1
End If
Loop While (Not cFind Is Nothing And cFind.Address <> firstAddress)
End If
Next
FindDimension = re
End Function
Function getStr(ByVal myStr As String)
Dim myArr() As Byte
Dim newArr As Byte
Dim newStr As String
'j = 0
' myArr = StrConv(myStr, vbFromUnicode)
' For i = 0 To UBound(myArr)
' If myArr(i) <> &H3F And myArr(i) <> &H20 Then
' newArr(j) = myArr(i)
' j = j + 1
' End If
' Next
'newStr = VBA.Replace(myStr, Chr(&H3F), Chr(&H20), , , vbBinaryCompare)
newStr = ""
For i = 1 To Len(myStr)
Dim ch
ch = Mid(myStr, i, 1)
'ch1 = Chr(&H3F)
If Asc(ch) <> &H3F Then
newStr = newStr & ch
End If
Next
getStr = newStr
End Function
|
| |
|
|
2009-05-27 16:50:43
