[已解决]数据行变列

dong66094799 · 发表于 2015-5-25 09:56

本帖最后由 dong66094799 于 2015-5-26 10:43 编辑

缴费数据.zip (7.26 KB, 下载次数: 15)

dong66094799 · 发表于 2015-5-25 09:57

在线等待，没看明白的，可以提问，谢谢各们

dsmch · 发表于 2015-5-25 10:45

Sub Macro1()
Dim arr, brr, i&, j%, k%, s&
arr = Sheet1.Range("a1").CurrentRegion
w = Array(6, 7, 8, 9, 10, 14)
ReDim brr(1 To 60000, 1 To UBound(arr, 2))
For i = 2 To UBound(arr)
For j = 0 To UBound(w)
If arr(i, w(j)) <> "" Then
s = s + 1
brr(s, w(j)) = arr(i, w(j))
For k = 1 To 4
brr(s, k) = arr(i, k)
Next
For k = 11 To 13
brr(s, k) = arr(i, k)
Next
End If
Next
Next
Sheet2.Activate
ActiveSheet.UsedRange.Clear
Sheet1.Rows(1).Copy [a1]
With Range("a2").Resize(s, UBound(brr, 2))
.Value = brr
.Borders.LineStyle = xlContinuous
End With
End Sub

复制代码

dsmch · 发表于 2015-5-25 10:47

………………

cyt381828864 · 发表于 2015-5-25 11:09

没看懂要表达的意思

dong66094799 · 发表于 2015-5-25 11:16

非常感谢（dsmch）3楼帮助，能不能把身份证号码那列修改为文本格式的，谢谢

dsmch · 发表于 2015-5-25 11:19

短信收到……
Sub Macro1()
Dim arr, brr, i&, j%, k%, s&
arr = Sheet1.Range("a1").CurrentRegion
w = Array(6, 7, 8, 9, 10, 14)
ReDim brr(1 To 60000, 1 To UBound(arr, 2))
For i = 2 To UBound(arr)
For j = 0 To UBound(w)
      If arr(i, w(j)) <> "" Then
         s = s + 1
         brr(s, w(j)) = arr(i, w(j))
         For k = 1 To 4
            brr(s, k) = IIf(k = 3, "'" & arr(i, k), arr(i, k))
         Next
         For k = 11 To 13
            brr(s, k) = arr(i, k)
         Next
      End If
Next
Next
Sheet2.Activate
ActiveSheet.UsedRange.Clear
Sheet1.Rows(1).Copy [a1]
With Range("a2").Resize(s, UBound(brr, 2))
.Value = brr
.Borders.LineStyle = xlContinuous
End With
End Sub

dong66094799 · 发表于 2015-5-25 13:44

非常感谢（dsmch）正解

li4213682 · 发表于 2015-5-25 16:03

我也是干社保的，认为缴费数据表还好用一点，请问楼主你改表的目的是什么啊！

dong66094799 · 发表于 2015-5-26 10:42

导入数据

		自动登录	找回密码
密码			注册