首页 > 代码库 > 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跨表转换数据
声明:以上内容来自用户投稿及互联网公开渠道收集整理发布,本网站不拥有所有权,未作人工编辑处理,也不承担相关法律责任,若内容有误或涉及侵权可进行投诉: 投诉/举报 工作人员会在5个工作日内联系你,一经查实,本站将立刻删除涉嫌侵权内容。