求助excel中数据无法拷出来

kunfeg

哪位大神能给看看，这些数据怎么能拷贝出来，万分感谢了！ 统计.rar (351.31 KB, 下载次数: 18)

2019-3-13 08:36 上传

点击文件名下载附件

weipdxy

您的数据保存有问题，应该是格式不对

kunfeg

weipdxy 发表于 2019-3-13 09:47
您的数据保存有问题，应该是格式不对

这是导出的数据不是保存的。

ljf8825

导出数据的时候能选格式吗？比如txt什么的

cavid001

感觉里面还有个表格，但是无法复制啊

刀羊

kunfeg 发表于 2019-3-13 10:30
这是导出的数据不是保存的。

这样啊，

倒成这样明显就是不让你直接拿数据。

cavid001

数据见excel表图片

cavid001

VBA代码如下：


Sub Test5()
  Dim Shape     As Shape
  Dim OLEObject As OLEObject
  Dim i, ii, jj
  i = 1




  For Each Shape In Sheet1.Shapes
    If Shape.Type = msoOLEControlObject Then

    Set OLEObject = Shape.OLEFormat.Object
                    ii = Fix(i / 15) + 1
            jj = i - 15 * (ii - 1)
            If jj = 0 Then jj = ii * 15
            Sheet2.Cells(ii, jj) = OLEObject.Object
            i = i + 1

   End If
  Next Shape
End Sub

cavid001

前面最后一列没显示出来，更正代码如下
Sub Test5()
  Dim Shape     As Shape
  Dim OLEObject As OLEObject
  Dim i, ii, jj
  i = 1
  
  
  
  
  For Each Shape In Sheet1.Shapes
    If Shape.Type = msoOLEControlObject Then
   
    Set OLEObject = Shape.OLEFormat.Object
                    ii = Fix(i / 15) + 1
            jj = i - 15 * (ii - 1)
            If jj = 0 Then
            jj = 15
            Sheet2.Cells(ii - 1, jj) = OLEObject.Object
        GoTo l1
            End If
            Sheet2.Cells(ii, jj) = OLEObject.Object
l1:            i = i + 1
   
   End If
  Next Shape
End Sub