Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

你正在寻找更好的Excel学习教程吗?Excel技巧80集+数据透视表+函数初中高全套+VBA80集,想学的这儿全都有
查看: 205|回复: 11
打印 上一主题 下一主题

[已解决] 求各位高手帮忙解决,表格排列的问题

[复制链接]
跳转到指定楼层
1楼
发表于 2020-3-29 15:27 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
将表1中的表格转换成表2中的样子,不考虑表头,我可以在整理前先删除表头。只要把表格按照序号排列下来就行。请高手帮助。

IRVV1{PZAS60H}RY(Q@ETP0.png (80.73 KB, 下载次数: 2)

IRVV1{PZAS60H}RY(Q@ETP0.png

0W~{8QPMJM~MD4%U_GKW7%3.png (32.47 KB, 下载次数: 2)

0W~{8QPMJM~MD4%U_GKW7%3.png

Book3.rar

31.61 KB, 下载次数: 3

分享到:  QQ好友和群QQ好友和群
收藏收藏
2楼
发表于 2020-3-29 16:25 | 只看该作者
N2:O2 下拉=OFFSET($B$2,MOD(ROW(A5),5)+INT(ROW(A15)/15)*8-7,MOD(INT(ROW(A5)/5)*4-5+COLUMN(A1),12)+1)&""

6771.png (9.16 KB, 下载次数: 2)

6771.png
回复

使用道具 举报

3楼
 楼主| 发表于 2020-3-29 19:21 | 只看该作者
hcm19522 发表于 2020-3-29 16:25
N2:O2 下拉=OFFSET($B$2,MOD(ROW(A5),5)+INT(ROW(A15)/15)*8-7,MOD(INT(ROW(A5)/5)*4-5+COLUMN(A1),12)+1)& ...

点号和类型也要在一起的呀?
回复

使用道具 举报

4楼
发表于 2020-3-30 08:11 | 只看该作者
回复

使用道具 举报

5楼
发表于 2020-4-2 17:25 | 只看该作者
Option Explicit

Dim A, B(1 To 10 ^ 4, 1 To 5), s

'多个表
Sub test()
    Dim i, x
    Application.ScreenUpdating = False
    Sheets(1).Select
    A = ActiveSheet.UsedRange
    s = 0

    x = 3
    For i = 3 To UBound(A)
        If InStr(A(i, 1), "界址点坐标表") Then
            Call test2(x, i - 2)
            x = i + 2
        End If
    Next i
    Call test2(x, i - 1)


    Sheets(3).Select
    Cells.Clear
    [a1:d1].Value = Sheets(1).[a2:d2].Value
    Range("a2").Resize(s, UBound(B, 2)) = B

    Call test4
End Sub


'一个表
Sub test2(x, y)
'    Debug.Print x, y
    Dim i, j, p

    For j = 1 To UBound(A, 2) Step 4
        p = x
        For i = x + 1 To y
            If A(i, j) <> "" Then
                Call test3(p, i - 1, j)
                p = i
            End If
        Next i
        Call test3(p, i - 1, j)
    Next j

End Sub


'一个合并
Sub test3(p, q, c)
'Debug.Print p, q
    Dim i
    For i = p To q
        s = s + 1
        B(s, 1) = A(i, c)
        B(s, 2) = A(i, c + 1)
        B(s, 3) = A(i, c + 2)
        B(s, 4) = A(i, c + 3)
    Next i
End Sub


Sub test4()
    Dim A, r, i, j

    Application.DisplayAlerts = False
    A = Range("a1").CurrentRegion
    r = UBound(A)
    For i = r To 2 Step -1
        If r > i Then
            If A(i, 1) <> "" Then
                For j = 1 To 2
                Range(Cells(i, j), Cells(r, j)).Merge
                Next j
                r = i - 1
            End If
        End If
    Next

    Range("a:d").EntireColumn.AutoFit
End Sub



3.rar (43.12 KB, 下载次数: 2)

评分

参与人数 2学分 +4 收起 理由
cutecpu + 2 学习
zwty51271 + 2 学习

查看全部评分

回复

使用道具 举报

6楼
 楼主| 发表于 2020-4-2 22:40 | 只看该作者
爱疯 发表于 2020-4-2 17:25
Option Explicit

Dim A, B(1 To 10 ^ 4, 1 To 5), s

很好用,谢谢帮助。但是VBA我看不懂,如果有其他类似的表格,可以复制代码操作吗?能不能用函数公式解决我的这个问题呢?
回复

使用道具 举报

7楼
发表于 2020-4-3 07:37 | 只看该作者
zwty51271 发表于 2020-4-2 22:40
很好用,谢谢帮助。但是VBA我看不懂,如果有其他类似的表格,可以复制代码操作吗?能不能用函数公式解决 ...

其他类似的表格,可能用不了,要改代码。公式的话,等函数高手们来看看吧
回复

使用道具 举报

8楼
发表于 2020-4-3 07:48 | 只看该作者
回复

使用道具 举报

9楼
 楼主| 发表于 2020-4-4 22:11 | 只看该作者
爱疯 发表于 2020-4-3 07:37
其他类似的表格,可能用不了,要改代码。公式的话,等函数高手们来看看吧

谢谢你,那看什么时候方便,能不能把上面的VBA语句弄个翻译或者解释,让我也学习一下。不知行不行?
回复

使用道具 举报

10楼
发表于 2020-4-4 22:32 | 只看该作者
zwty51271 发表于 2020-4-4 22:11
谢谢你,那看什么时候方便,能不能把上面的VBA语句弄个翻译或者解释,让我也学习一下。不知行不行?

您好,可报名「Excel精英培训 - VBA入门班26期」
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2020-4-28 06:21 , Processed in 0.078000 second(s), 6 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表
拼三张下载