| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 4357 人关注过本帖
标题:求助:求老司机带路,求VBA代码实现Sheet1曲线数据汇总到Sheet2,谢谢!
只看楼主 加入收藏
心云德乐
Rank: 1
等 级:新手上路
帖 子:11
专家分:0
注 册:2019-8-23
结帖率:50%
收藏
已结贴  问题点数:10 回复次数:5 
求助:求老司机带路,求VBA代码实现Sheet1曲线数据汇总到Sheet2,谢谢!
图片附件: 游客没有浏览图片的权限,请 登录注册
图片附件: 游客没有浏览图片的权限,请 登录注册
批量曲线提取.rar (143.92 KB)
搜索更多相关主题的帖子: 汇总 代码 曲线 VBA 数据 
2019-11-18 01:51
lidaufo
Rank: 2
等 级:论坛游民
帖 子:5
专家分:10
注 册:2019-11-10
收藏
得分:10 
不会
2019-11-18 15:34
厨师王德榜
Rank: 18Rank: 18Rank: 18Rank: 18Rank: 18
等 级:贵宾
威 望:199
帖 子:989
专家分:4966
注 册:2013-2-16
收藏
得分:0 
有趣的问题,今天有时间,做了一下.
凡是取到的格子,用颜色标志了:
图片附件: 游客没有浏览图片的权限,请 登录注册
收到的鲜花
2019-11-27 17:03
厨师王德榜
Rank: 18Rank: 18Rank: 18Rank: 18Rank: 18
等 级:贵宾
威 望:199
帖 子:989
专家分:4966
注 册:2013-2-16
收藏
得分:0 
取到的数据,放在Sheet2:
图片附件: 游客没有浏览图片的权限,请 登录注册
2019-11-27 17:03
厨师王德榜
Rank: 18Rank: 18Rank: 18Rank: 18Rank: 18
等 级:贵宾
威 望:199
帖 子:989
专家分:4966
注 册:2013-2-16
收藏
得分:0 
代码也一并放出来吧,供你参考:
程序代码:
Sub getOrder()
'按一定规律取值到数组,并输出到表2
'Code by:厨师王德榜
'2019-11-27
Dim iLR As Integer  '-1/+1 向左还是向右
Dim irow As Integer, icolN As Integer
Dim icolStart As Integer, icolEnd As Integer
Dim arr1()  As Integer
icolN = 1
icolEnd = 1
iLR = -1
ReDim arr1(41 - 4)
Worksheets("Sheet1").Activate
Application.ScreenUpdating = False
Do Until Cells(4, (icolN - 1) * 8 + 1).Text = ""
    For irow = 4 To 41
        If irow = 4 Then
            iLR = -1
            icolStart = (icolN - 1) * 8 + 2
        Else
            If (icolStart + 1) Mod 8 = 0 Or icolStart Mod 8 = 1 Then
                iLR = iLR * -1
            End If
        End If
        If icolStart = 0 Then icolStart = 1
        arr1(irow - 4) = Cells(irow, icolStart).Value
        Cells(irow, icolStart).Select
        With Selection.Font
            .Color = -16777024
            .TintAndShade = 0
            .Bold = True
        End With
        icolStart = icolStart + iLR
        icolEnd = IIf(icolStart > icolEnd, icolStart, icolEnd)
    Next irow
    '输出数组(到Sheet2):
    Worksheets("Sheet2").Activate
    Cells(4, icolN).Resize(38, 1) = Application.Transpose(arr1)
    ReDim arr1(41 - 4)  '输出后,清空数组,方便给下一轮使用.
    Worksheets("Sheet1").Activate
    icolN = icolN + 1
Loop
Application.ScreenUpdating = True
MsgBox "计算完毕。最末列探测到第" & icolEnd & "列."
End Sub
收到的鲜花
2019-11-27 17:04
心云德乐
Rank: 1
等 级:新手上路
帖 子:11
专家分:0
注 册:2019-8-23
收藏
得分:0 
回复 5楼 厨师王德榜
第一是谢谢!
    第二是感谢!
        第三是谢谢!+感谢!
2019-12-11 20:43
快速回复:求助:求老司机带路,求VBA代码实现Sheet1曲线数据汇总到Sheet2,谢谢 ...
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.016260 second(s), 10 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved