如何将表1设置成表 2

Cathyoo

3190496160

这个得用代码才行吧

3190496160

Sub 调整()
Application.ScreenUpdating = False
Dim ar As Variant, cr As Variant
Dim i As Long, r As Long, rs As Long
Dim br()
With Sheets("sheet1")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    y = .Cells(1, Columns.Count).End(xlToLeft).Column
    ar = .Range(.Cells(1, 1), .Cells(r, y))
End With
ReDim br(1 To 50000, 1 To 2)
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) = "" Then ar(i, 1) = ar(i - 1, 1)
    For j = 2 To UBound(ar, 2)
        If Trim(ar(i, j)) <> "" Then
            If ar(i, j) <> 0 Then
                n = n + 1
                br(n, 1) = ar(i, 1)
                br(n, 2) = ar(1, j)
            End If
        End If
    Next j
Next i
If n = "" Then MsgBox "没有需要调整的数据！": End
With Sheet2
    .Range("a1:b" & .Cells(Rows.Count, 1).End(xlUp).Row) = Empty
    .[a1].Resize(n, 2) = br
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

新建 XLS 工作表.rar (16.94 KB, 下载次数: 7)

2023-9-27 14:24 上传

点击文件名下载附件

Cathyoo

3190496160 发表于 2023-9-27 14:24

请问是怎样操作啊？

沈默00

用VBA比较好，点按钮就好了

沈默00

原表格坑很多，有空字符，居然有两个数据源，就隔了个空行，差点没发现
本来很简单的，结果代码多写了不少，还好算是完成任务了

gwjkkkkk

请参考。。。