|
请大师帮我改写
Sub 位置1()
Dim d As Object, arr, i
Set d = CreateObject("Scripting.dictionary")
arr = Sheet1.Range("AY21:AY140")
For Each ar In arr
If Len(ar) Then d(ar) = ""
Next
Sheet2.Cells(21, 41).Resize(d.Count) = Application.Transpose(d.keys)
位置2
End Sub
Sub 位置2()
Dim d As Object, arr, i
Set d = CreateObject("Scripting.dictionary")
arr = Sheet1.Range("AZ21:AZ140")
For Each ar In arr
If Len(ar) Then d(ar) = ""
Next
Sheet2.Cells(21, 42).Resize(d.Count) = Application.Transpose(d.keys)
位置3
End Sub
Sub 位置3()
Dim d As Object, arr, i
Set d = CreateObject("Scripting.dictionary")
arr = Sheet1.Range("BA21:BA140")
For Each ar In arr
If Len(ar) Then d(ar) = ""
Next
Sheet2.Cells(21, 43).Resize(d.Count) = Application.Transpose(d.keys)
位置4
End Sub
Sub 位置4()
Dim d As Object, arr, i
Set d = CreateObject("Scripting.dictionary")
arr = Sheet1.Range("BB21:BB140")
For Each ar In arr
If Len(ar) Then d(ar) = ""
Next
Sheet2.Cells(21, 44).Resize(d.Count) = Application.Transpose(d.keys)
位置5
End Sub
Sub 位置5()
Dim d As Object, arr, i
Set d = CreateObject("Scripting.dictionary")
arr = Sheet1.Range("BC21:BC140")
For Each ar In arr
If Len(ar) Then d(ar) = ""
Next
Sheet2.Cells(21, 45).Resize(d.Count) = Application.Transpose(d.keys)
位置6
End Sub
Sub 位置6()
Dim d As Object, arr, i
Set d = CreateObject("Scripting.dictionary")
arr = Sheet1.Range("BD21:BD140")
For Each ar In arr
If Len(ar) Then d(ar) = ""
Next
Sheet2.Cells(21, 46).Resize(d.Count) = Application.Transpose(d.keys)
位置7
End Sub
Sub 位置7()
Dim d As Object, arr, i
Set d = CreateObject("Scripting.dictionary")
arr = Sheet1.Range("BE21:BE140")
For Each ar In arr
If Len(ar) Then d(ar) = ""
Next
Sheet2.Cells(21, 47).Resize(d.Count) = Application.Transpose(d.keys)
位置8
End Sub
Sub 位置8()
Dim d As Object, arr, i
Set d = CreateObject("Scripting.dictionary")
arr = Sheet1.Range("BF21:BF140")
For Each ar In arr
If Len(ar) Then d(ar) = ""
Next
Sheet2.Cells(21, 48).Resize(d.Count) = Application.Transpose(d.keys)
位置9
End Sub
Sub 位置9()
Dim d As Object, arr, i
Set d = CreateObject("Scripting.dictionary")
arr = Sheet1.Range("BG21:BG140")
For Each ar In arr
If Len(ar) Then d(ar) = ""
Next
Sheet2.Cells(21, 49).Resize(d.Count) = Application.Transpose(d.keys)
位置0
End Sub
Sub 位置0()
Dim d As Object, arr, i
Set d = CreateObject("Scripting.dictionary")
arr = Sheet1.Range("BH21:BH140")
For Each ar In arr
If Len(ar) Then d(ar) = ""
Next
Sheet2.Cells(21, 50).Resize(d.Count) = Application.Transpose(d.keys)
End Sub
|
|