jkluio668
2/3/2018 - 4:32 PM

spider_field

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