主题：求助：导入剪贴板的数据的代码

如题！求助高手写个简单代码高效率

在Excel文件中复制内容，打开狐表表格进行贴粘，能够自动对应列进行贴粘。

贴粘按钮，代码如下：

Dim vWIN1v,vTB1v,vTB2v,Values1(),Values2(),s As String
vWIN1v = "窗口48"
vTB1v = vWIN1v & "_Table1" '临时表
vTB2v = CurrentTable.Name '粘贴表
Dim ii,n As Integer
If Tables(vTB2v).AllowEdit Andalso ClipBoard.ContainsText Then '判断字符串,判断粘贴表可编辑
    For Each cl As Col In Tables(vTB2v).Cols
        If cl.Visible Andalso cl.AllowEdit Then
            ii = 1
        End If
    Next
    If ii = 1 Then '粘贴的目标表必须有可见列并且可编辑列
        s = ClipBoard.GetText() '获取总的字符串
        n = s.Length - s.Replace(chr(13),"").Length
        If n > 1 Then '判断复制的记录必须大于1
            Values1 = s.Split(chr(13)) '拆为复制的内容为一行一行记录
            Values2 = Values1(0).Split(vbTab) '提取复制的内容的列数
            Forms(vWIN1v).Show()
            DataTables(vTB1v).DataRows.Clear() '清空记录
            Tables(vTB1v).AllowEdit = True '可编辑表
            Application.DoEvents
            If Values2.Length > Tables(vTB1v).Cols.Count Then '临时表的列数不足进行添加列
                For i As Integer = Tables(vTB1v).Cols.Count + 1 To Values2.Length
                    DataTables(vTB1v).DataCols.Add("第" & i & "列",Gettype(String),255)
                Next
            End If
            Tables(vTB1v).AddNew(n) '临时表添加行
            Tables(vTB1v).Select(0,0) '临时表选定第一行第一列的单元格
            Tables(vTB1v).Focus '移动焦点到临时表
            Tables(vTB1v).StopRedraw '关闭绘制
            Syscmd.Edit.Paste() '粘贴到临时表
            Tables(vTB1v).ResumeRedraw '恢复绘制
            Application.DoEvents
            If Tables(vTB1v).Rows.Count > 1 Then '临时表的记录大于1行
                Dim dr As Row = Tables(vTB1v).Rows(0) '提取临时表的第一行记录
                For Each cl1 As DataCol In DataTables(vTB1v).DataCols '临时表修改标题
                    If dr(cl1.Name) IsNot Nothing Andalso dr(cl1.Name) <> "" Then '临时表的单元格不为空
                        For Each cl2 As Col In Tables(vTB2v).Cols '粘贴表相同标题
                            If cl2.AllowEdit Andalso cl2.Visible Then '粘贴表的可编辑列与可显示列
                                If cl2.Caption IsNot Nothing Andalso cl2.Caption <> "" Then '标题不为空
                                    If cl2.Caption = dr(cl1.Name) Then
                                        cl1.Caption = cl2.Name
                                    End If
                                Else '标题为空
                                    If cl2.Name = dr(cl1.Name) Then
                                        cl1.Caption = cl2.Name
                                    End If
                                End If
                            End If
                        Next
                    End If
                Next
                DataTables(vTB1v).BuildHeader
                Tables(vTB1v).Rows.Delete(0)
                Dim drnew As Row
                For Each dr1 As Row In Tables(vTB1v).Rows '循环临时表的所有行
                    drnew = Tables(vTB2v).AddNew()
                    For Each cl1 As DataCol In DataTables(vTB1v).DataCols '循环临时表的所有标题
                        If cl1.Caption IsNot Nothing Andalso cl1.Caption <> "" Then '临时表标题不为空
                            drnew(cl1.Caption) = dr1(cl1.Name)
                        End If '临时表标题不为空
                    Next '循环临时表的所有标题
                Next '循环临时表的所有行
            End If
            Application.DoEvents
            Forms(vWIN1v).Close()
        Else
            MessageBox.Show("复制的记录必须大于1,请检查!!!","提示")
        End If
    Else
        MessageBox.Show("粘贴的目标表必须有可见列并且是可以编辑列,请检查!!!","提示")
    End If
Else
    MessageBox.Show("粘贴的目标表必须是可编辑,并且粘贴的内容必须是数据,请检查!!!","提示")
End If