紧急求助高手！！！！

爱疯 发表于 2019-4-2 16:37
Sub test()
    Dim A, p, i
    Application.ScreenUpdating = False

多谢前辈 厉害了

leisong22

爱疯 发表于 2019-4-2 16:37
Sub test()
    Dim A, p, i
    Application.ScreenUpdating = False

请教老师，按照您的做出来后，第6行的（交接内容：）不显示数据，还有第9行里面有3项需要填写的，做出来只显示第一项的内容

爱疯

能上传出错的附件吗

leisong22

leisong22

爱疯 发表于 2019-4-4 09:52
能上传出错的附件吗

附件内注明了！

爱疯

Sub test()
    Dim A, p, i
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    p = ThisWorkbook.Path & "\"
    A = Sheets(2).Range("a1").CurrentRegion
    Sheets(1).Select

    For i = 2 To UBound(A)
        [b2] = A(i, 1)    '中继段名称
        [h2] = A(i, 2)    '交接时间
        [b3] = A(i, 3)    '光缆级别
        [d3] = A(i, 4)    '光缆芯数
        [f3] = A(i, 5)    '皮长公里 (KM)
        [h3] = A(i, 6)    '区县
        [b4] = A(i, 7)    '敷设方式 (可填多种)
        [e4] = A(i, 8)    '地形 (可填多种)
        [b5] = A(i, 9)    '杆?井?标石号
        [a6] = "交接内容：" & A(i, 10)    '交接内容:
        [b7] = A(i, 11)    '遗留问题:
        [a10] = "交出单位：" & A(i, 12)    '交出单位:
        [a11] = "接收单位：" & A(i, 13)    '接收单位:
        [b8] = A(i, 14)    '移动方意见:
        [b9] = A(i, 15)    '移动方（签字）：
        [d9] = A(i, 16)    '交出方（签字）：
        [f9] = A(i, 17)    '接收方（签字）：

        Sheets(1).Copy
        With ActiveWorkbook
            .SaveAs p & A(i, 1)
            .Close
        End With
    Next i
End Sub

3.rar (20.79 KB, 下载次数: 1)

2019-4-4 10:34 上传

点击文件名下载附件

chulia520