|
Range("i2:p" & [b10000].End(3).Row).ClearContents
Application.ScreenUpdating = False
Dim arr1(100, 2)
js = 0
For i = 60 To Worksheets("产品结构表").Range("h80").End(3).Row
js = js + 1
arr1(js, 1) = Worksheets("产品结构表").Cells(i, "h")
arr1(js, 2) = Worksheets("产品结构表").Cells(i, "i")
Next i
Dim arr
arr = Worksheets("产品结构表").Range("a1:x" & Worksheets("产品结构表").[d10000].End(3).Row)
For i = 2 To [b10000].End(3).Row
For k = 2 To UBound(arr)
If UCase(Cells(i, 6)) = UCase(arr(k, 13)) Then
Cells(i, "i") = arr(k, 14)
End If
If UCase(Cells(i, 4)) = UCase(arr(k, 1)) Then
Cells(i, "j") = arr(k, 2)
End If
If UCase(Cells(i, 5)) = UCase(arr(k, 4)) Then
Cells(i, "k") = arr(k, 5)
Cells(i, "p") = arr(k, 6)
End If
If UCase(Cells(i, 4)) = UCase(arr(k, 16)) Then
Cells(i, "l") = arr(k, 17)
Cells(i, "m") = arr(k, 18)
End If
Next k
If Not IsEmpty(Cells(i, "f")) Then
bz = False
For j = 1 To js
If UCase(Cells(i, "f")) = UCase(arr1(j, 1)) Then
bz = True
jl = j
Exit For
End If
Next j
If bz Then
Cells(i, "n") = arr1(jl, 2) & Cells(i, "l")
Else
Cells(i, "n") = Cells(i, "f") & Cells(i, "l")
End If
End If
If Not IsEmpty(Cells(i, "i")) Then
Cells(i, "o") = Cells(i, "i") & Cells(i, "m")
End If
If Not IsEmpty(Cells(i, "j")) Then
Cells(i, "q") = Cells(i, "j") & Cells(i, "p")
End If
Next i
Application.ScreenUpdating = True
1、说明:
判断时不区分大小写,但读取的结果还是源数据,源数据是小写结果也是小写,源数据是大写结果也是大写;
2、增加了特别处理的代码:
读取特别处理的数据区域,目前暂定为h60-h80之间的活动区域
For i = 60 To Worksheets("产品结构表").Range("h80").End(3).Row
js = js + 1
arr1(js, 1) = Worksheets("产品结构表").Cells(i, "h") '转换前的内容
arr1(js, 2) = Worksheets("产品结构表").Cells(i, "i") '转换后的内容
Next i
对特别区域进行判断:
For j = 1 To js 对照数组查询是否为特定区域的数据
If UCase(Cells(i, "f")) = UCase(arr1(j, 1)) Then
bz = True
jl = j
Exit For
End If
Next j
If bz Then '如果是特定区域的数据,转换后拼接,转换数据存放在数组 arr1(jl,2) 中
Cells(i, "n") = arr1(jl, 2) & Cells(i, "l")
Else '不是特定区域的数据直接拼接
Cells(i, "n") = Cells(i, "f") & Cells(i, "l")
End If
|
|