|
楼主 |
发表于 2017-1-9 10:30
|
显示全部楼层
Sub 垫宽厚()
Dim d, k, js, e1(1 To 10000), e2(1 To 10000), e3(1 To 10000)
js = Int(Sheets("垫原").Cells(600000, 1).End(xlUp).Row / 50) + 1
' Set d = CreateObject("Scripting.Dictionary")
'MsgBox js
m = 1
For i = 1 To js
For j = 2 To 17
If Sheets("垫原").Cells((i - 1) * 50 + 10, j) <> "" Then
e1(m) = Sheets("垫原").Cells((i - 1) * 50 + 4, 14) & Sheets("垫原").Cells((i - 1) * 50 + 6, j)
e2(m) = Sheets("垫原").Cells((i - 1) * 50 + 10, j)
e3(m) = Sheets("垫原").Cells((i - 1) * 50 + 13, j)
m = m + 1
End If
Next
Next
js = Int(Sheets("垫宽").Cells(600000, 1).End(xlUp).Row / 50) + 1
For i = 1 To js
For j = 7 To 37
If Sheets("垫宽").Cells((i - 1) * 50 + j, 1) <> "" Then
a = Sheets("垫宽").Cells((i - 1) * 50 + 4, 11) & Sheets("垫宽").Cells((i - 1) * 50 + j, 1)
位置 = Application.Match(a, e1, 0)
Sheets("垫宽").Cells((i - 1) * 50 + j, 2) = e2(位置) / 100
If 提取数字(Sheets("垫宽").Cells((i - 1) * 50 + j, 1)) Mod 100 = 0 Then
a = Sheets("垫宽").Cells((i - 1) * 50 + 4, 11) & Sheets("垫宽").Cells((i - 1) * 50 + j, 1)
位置 = Application.Match(a, e1, 0)
Sheets("垫宽").Cells((i - 1) * 50 + j, 8) = e3(位置) / 1
End If
End If
Next
Next
'Set e1 = Nothing
' Set e2 = Nothing
' Set e3 = Nothing
End Sub
Sub 基宽厚()
Dim d, k, js, a1(1 To 10000), a2(1 To 10000), a3(1 To 10000), a4(1 To 10000)
js = Int(Sheets("基原").Cells(600000, 1).End(xlUp).Row / 50) + 1
' Set d = CreateObject("Scripting.Dictionary")
'MsgBox js
m = 1
For i = 1 To js
For j = 2 To 17
If Sheets("基原").Cells((i - 1) * 50 + 10, j) <> "" Then
a1(m) = Sheets("基原").Cells((i - 1) * 50 + 3, 9) & Sheets("基原").Cells((i - 1) * 50 + 9, j)
a2(m) = Sheets("基原").Cells((i - 1) * 50 + 10, j)
a3(m) = Sheets("基原").Cells((i - 1) * 50 + 12, j)
a4(m) = Sheets("基原").Cells((i - 1) * 50 + 13, j)
m = m + 1
End If
Next
Next
js = Int(Sheets("基宽").Cells(600000, 1).End(xlUp).Row / 50) + 1
For i = 1 To js
For j = 7 To 37
If Sheets("基宽").Cells((i - 1) * 50 + j, 1) <> "" Then
a = Sheets("基宽").Cells((i - 1) * 50 + 4, 11) & Sheets("基宽").Cells((i - 1) * 50 + j, 1)
位置 = Application.Match(a, a1, 0)
Sheets("基宽").Cells((i - 1) * 50 + j, 2) = a2(位置) / 100
If 提取数字(Sheets("基宽").Cells((i - 1) * 50 + j, 1)) Mod 100 = 0 Then
a = Sheets("基宽").Cells((i - 1) * 50 + 4, 11) & Sheets("基宽").Cells((i - 1) * 50 + j, 1)
位置 = Application.Match(a, a1, 0)
Sheets("基宽").Cells((i - 1) * 50 + j, 8) = a3(位置) / 1
End If
End If
Next
Next
'Set a1 = Nothing
'Set a2 = Nothing
'Set a3 = Nothing
End Sub
我这个能实现。在家里电脑还行,到单位Set a3 = Nothing,不让赋值,只能取消了 |
|