求助，求老司机带路，求VBA代码实现Sheet1曲线数据汇总到Sheet2，谢谢！

心云德乐

批量曲线提取.rar (143.92 KB, 下载次数: 6)

2019-11-18 01:48 上传

点击文件名下载附件

约定的童话

这个有意思哈，干嘛这样取值啊？Sub 取值()
    Dim i, n, arr, brr
    arr = Sheet1.UsedRange
    ReDim brr(1 To 38, 1 To UBound(arr, 2))
    For j = 1 To UBound(arr, 2) Step 8
        m = m + 1
        For i = 1 To UBound(arr)
            n = n + 1
            If n = 1 Then
                brr(n, m) = arr(1, j + 1)
            Else
                If k = 7 Then
                    h = h - 1
                    brr(n, m) = arr(i, j + h - 1)
                    If h = 1 Then k = 1
                Else
                    k = k + 1
                    brr(n, m) = arr(i, j + k - 1)
                    If k = 7 Then h = 7
                End If
            End If
        Next
        k = 0: h = 0: n = 0
    Next
    Cells.Clear
    [a4].Resize(38, UBound(arr, 2)) = brr
    MsgBox "处理完毕！", , ""
End Sub

心云德乐

约定的童话 发表于 2019-11-18 08:16
这个有意思哈，干嘛这样取值啊？Sub 取值()
    Dim i, n, arr, brr
    arr = Sheet1.UsedRange

首先谢谢VBA经验丰富的高手:      这么说吧!本人自己折腾一个学习VBA项目,其中的估计一个VBA程序100多行代码,可以东拼西凑复制书本的代码再上             VBA论坛求教!
              问题是不一定有高手回复,如果拆开来分小段求助,成功的机率比较高,
                    现学习目标是看懂高手的50行VBA代码并自己加写上注释,

心云德乐

约定的童话 发表于 2019-11-18 08:16
这个有意思哈，干嘛这样取值啊？Sub 取值()
    Dim i, n, arr, brr
    arr = Sheet1.UsedRange

请问高手，有几个声明数据类型的问题想不明白，请教下？

约定的童话

心云德乐 发表于 2019-11-18 23:14
请问高手，有几个声明数据类型的问题想不明白，请教下？

原来是学习的啊：brr不能加括号，下面我要重新定义brr的维度，Redim那句，brr的维度大小需要根据ARR的维度来确定，必须在ARR确定后才能定义，所以不能提前加括号，不然报错，你可以试一下！里面的j,k,m,n都是&型变量，这个符号按照规范化书写必须要加的，个人习惯，至于变量类型这个你可以看下基础资料！代码的重点在逻辑循环这上面，你F8一句句看下，然后慢慢理解！

心云德乐

约定的童话 发表于 2019-11-19 08:17
原来是学习的啊：brr不能加括号，下面我要重新定义brr的维度，Redim那句，brr的维度大小需要根据ARR的维 ...

高手好：复制了您的VBA代码后运行良好，可是！我发现了一个关键的问题？您的代码是从每个数据区域第一行的第二个单元格开始向下曲线提取数据的，如果改变思路，改成从最底行（38）的第一个（左下角的第一个单元格）开始向上曲线提取，又该怎样修改您的VBA代码呢？谢谢！

约定的童话

心云德乐 发表于 2019-11-20 01:10
高手好：复制了您的VBA代码后运行良好，可是！我发现了一个关键的问题？您的代码是从每个数据区域第一行 ...

看基础知识去吧，你这样问下去何时是个头啊

心云德乐

约定的童话 发表于 2019-11-20 13:10
看基础知识去吧，你这样问下去何时是个头啊

谢谢您的三次的回复，你每回复一次，我进步巨大，欣赏你的三句话：
1.这个有意思哈，干嘛这样取值啊？

2.代码的重点在逻辑循环这上面，你F8一句句看下，然后慢慢理解！

3.看基础知识去吧，你这样问下去何时是个头啊！
第一句让我满肚子醋意，学python几年，结果从入门到放弃，了解VBA练手好，才转向VBA，结果为啦学VBA又去考计算机二级Ms Office,刚前几个月拿证，就你的第一句话，让我前面养成的思维严谨和逻辑性大暴发，谢谢！

约定的童话

心云德乐 发表于 2019-11-20 22:23
谢谢您的三次的回复，你每回复一次，我进步巨大，欣赏你的三句话：
1.这个有意思哈，干嘛这样取值啊？
...

ubound(arr,2)指的是arr最大列维度，不能改成5，这个地方你理解错误了

xiangbaoan

Option Explicit
Sub test()
    Dim lc&, c&, ar, i&, j&, x&
    With Sheet1
        lc = .Cells(4, .Columns.Count).End(xlToLeft).Column
        For c = 1 To lc Step 8
            x = x + 1
            ar = .Cells(4, c).CurrentRegion
            If x = 1 Then ReDim br(1 To UBound(ar), 1 To -Int(-lc / 8))
            For i = 1 To UBound(ar)
                j = 7 - Abs(((i + 10) Mod 12) - 7 + 1)
                br(i, x) = ar(i, j)
            Next
        Next
    End With
    Sheet2.[a4].Resize(i - 1, x) = br
End Sub