求各位高手帮忙解决，表格排列的问题

zwty51271

将表1中的表格转换成表2中的样子，不考虑表头，我可以在整理前先删除表头。只要把表格按照序号排列下来就行。请高手帮助。

hcm19522

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)&""

zwty51271

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)& ...

点号和类型也要在一起的呀？

蓝色冰焰

爱疯

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)

2020-4-2 17:25 上传

点击文件名下载附件

zwty51271

爱疯 发表于 2020-4-2 17:25
Option Explicit

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

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

爱疯

zwty51271 发表于 2020-4-2 22:40
很好用，谢谢帮助。但是VBA我看不懂，如果有其他类似的表格，可以复制代码操作吗？能不能用函数公式解决 ...

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

蓝色冰焰

zwty51271

爱疯 发表于 2020-4-3 07:37
其他类似的表格，可能用不了，要改代码。公式的话，等函数高手们来看看吧

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

cutecpu

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

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