首页 > 代码库 > 20170621xlVBA跨表转换数据

20170621xlVBA跨表转换数据

Sub 跨表转置()
    Dim Wb As Workbook
    Dim Sht As Worksheet
    Dim oSht As Worksheet
    Dim Rng As Range
    Dim Index As Long

    Const HeadRow As Long = 12
    Set Wb = Application.ThisWorkbook
    Set Sht = Wb.Worksheets("模板")
    Set oSht = Wb.Worksheets("数据表")

    With Sht
        .UsedRange.Offset(HeadRow).ClearContents
    End With

    With oSht
        endrow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
        Set Rng = .Range("A3:O" & endrow)
        Index = HeadRow
        With Rng
            For i = 1 To .Rows.Count
                Index = Index + 1
                Sht.Cells(Index, "C").Value = http://www.mamicode.com/.Cells(i,"A").Text    ‘姓名
                Sht.Cells(Index, "D").Value = "http://www.mamicode.com/‘" & .Cells(i, "B").Text    ‘手机
                Sht.Cells(Index, "E").Value = "http://www.mamicode.com/‘" & Replace(.Cells(i, "C").Text, "-", "/")    ‘生日
                Sht.Cells(Index, "F").Value = "http://www.mamicode.com/‘" & .Cells(i, "D").Text    ‘证件号
                Sht.Cells(Index, "G").Value = http://www.mamicode.com/Split(.Cells(i,"E").Text, " ")(0)    ‘证件类型
                Sht.Cells(Index, "H").Value = http://www.mamicode.com/Split(.Cells(i,"F").Text, " ")(0)    ‘性别
                Sht.Cells(Index, "I").Value = http://www.mamicode.com/Split(.Cells(i,"G").Text, " ")(0) & "型"   ‘血型
                Sht.Cells(Index, "J").Value = http://www.mamicode.com/Split(.Cells(i,"H").Text, " ")(0)    ‘国际

                x = UBound(Split(.Cells(i, "H").Text, " "))
                If x >= 1 Then Sht.Cells(Index, "K").Value = http://www.mamicode.com/Split(.Cells(i,"H").Text, " ")(1)
                If x >= 2 Then Sht.Cells(Index, "L").Value = http://www.mamicode.com/Split(.Cells(i,"H").Text, " ")(2)
                If x = 3 Then Sht.Cells(Index, "M").Value = http://www.mamicode.com/Split(.Cells(i,"H").Text, " ")(3)

                Sht.Cells(Index, "N").Value = http://www.mamicode.com/Split(.Cells(i,"I").Text, " ")(0)    ‘项目
                Sht.Cells(Index, "O").Value = http://www.mamicode.com/.Cells(i,"K").Text    ‘尺寸
                Sht.Cells(Index, "P").Value = http://www.mamicode.com/.Cells(i,"L").Text    ‘地址
                Sht.Cells(Index, "Q").Value = http://www.mamicode.com/.Cells(i,"M").Text    ‘邮箱

                Sht.Cells(Index, "S").Value = http://www.mamicode.com/.Cells(i,"N").Text    ‘紧急联系人
                Sht.Cells(Index, "T").Value = http://www.mamicode.com/.Cells(i,"O").Text    ‘电话
                ‘  Sht.Cells(Index, "U").Value = "http://live.yongdongli.net/page/photo.php?n=" & .Cells(i, "A").Text
                addres = "http://live.yongdongli.net/page/photo.php?n=" & .Cells(i, "A").Text
                Sht.Hyperlinks.Add Anchor:=Sht.Cells(Index, "U"), Address:=addres, TextToDisplay:=addres

            Next i
        End With

    End With



    Set Wb = Nothing
    Set Sht = Nothing
    Set oSht = Nothing


End Sub

  

20170621xlVBA跨表转换数据