Sub copy1()
copy_1 (1)
End Sub
Sub copy2()
copy_1 (2)
End Sub
Sub copy3()
copy_1 (3)
End Sub
Function copy_1(arg)
'Application.ScreenUpdating = 0 '这种选中复制的方法,不能用ScreenUpdating
c1 = 50 '在第50列ax,处理复制
a1 = convert1(c1)
b1 = convert1(c1 + 1)
Range(a1 & ":" & b1).ClearContents
'Sheets(2).[a:b].ClearContents
' Dim arr1()
' ReDim arr1(1 To 100, 1 To 2)
a = Selection.Row
If a = 1 Then
MsgBox "不能选择第一行"
End
End If
a2 = Selection.Column
k = convert1(find_col_1("py_file_title"))
j = 1
For i = k To Cells(a, c1 - 1).End(xlToLeft).Column
If Cells(a, i) <> "" Then
Cells(j, c1) = Cells(1, i)
Cells(j, c1 + 1) = Cells(a, i)
' arr1(j, 1) = Cells(1, i)
' arr1(j, 2) = Cells(a, i)
' Sheets(2).Cells(j, 1) = Cells(1, i)
' Sheets(2).Cells(j, 2) = Cells(a, i)
j = j + 1
''ReDim Preserve arr1(1 To j, 1 To 2) 'Preserve _
只会改变最后一维的,这样写会报错。或者用列的方式,或者用去除二维数组的空行的方式
'ReDim Preserve arr1(1 To 2, 1 To j) 'j最大只能是256
End If
Next
'-----
'如果用二维数组的方法,发送到clip,较麻烦
' Sheets(2).Activate
' Sheets(2).Range("A1:B" & Sheets(2).Range("a65536").End(xlUp).Row).Select
' Selection.Copy
' Sheets(1).Activate
'---
Range(a1 & "1:" & b1 & Range(a1 & "65536").End(xlUp).Row).Select
If arg = 1 Then
Selection.copy '普通样式
Else
str1 = ""
For i = 1 To Range(a1 & "65536").End(xlUp).Row
str2 = Replace(Cells(i, b1).Text, " ", " > ")
If arg = 2 Then '列表样式,只需要第一列,而不需要第二列
str1 = str1 + " ['" & Cells(i, a1) & "','" & _
str2 & "']," & Chr(10) & Chr(13)
'下一行的代码无意义
'str1 = str1 + " ['" & Cells(i, a1) & "','i.select(" & _
Chr(34) & str2 & Chr(34) & ")']," & Chr(10) & Chr(13)
Else '赋值样式
If Cells(i, a1) <> "frame_1" Then
str1 = str1 + " " & Cells(i, a1) & " = i.select(" & _
Chr(34) & str2 & Chr(34) & ")[0]"
If Cells(i, a1).Text Like "*url*" Then
str1 = str1 & "[" & Chr(34) & "href" & Chr(34) & "]"
Else
str1 = str1 & ".text"
End If
str1 = str1 & Chr(10) & Chr(13)
End If
End If
Next
CopyToClipbox str1
End If
Cells(a, a2).Select
'Application.ScreenUpdating = 1
End Function