二维表与一维表之间互转！

idealxp

idealxp

二维表中无数据的转的过程也留下来！

zpy2

是不是需要上传一个附件？

mmwwdd

上传附件,用SQL给你做一下

明天会更好zj

Sub TwotoOne()
Dim arr, brr(1 To 30000, 1 To 5)
Dim i, j, k, n
arr = Sheets("成绩册").Range("a1").CurrentRegion

For i = 2 To UBound(arr)
    For j = 4 To UBound(arr, 2)
        n = n + 1
        brr(n, 1) = arr(i, 1)
        brr(n, 2) = arr(i, 2)
        brr(n, 3) = arr(i, 3)
        brr(n, 4) = arr(1, j)
        brr(n, 5) = arr(i, j)
    Next
Next

With Sheets("一维")
    .Cells.ClearContents
    .Columns("b:b").NumberFormatLocal = "@"
    .Range("a1:e1") = Array("班级", "考号", "姓名", "科目", "成绩")
    .[a2].Resize(n, 5) = brr
End With
End Sub

3190496160

求助务必上传附件才能得到别人的帮助，你的问题，是可以解决的，前提是上传附件

明天会更好zj

Sub OnetoTwo()
Dim arr, brr
Dim Dic As Object, Eic As Object
Dim i, j, k, n
Dim str As String, ttr As String

Set Dic = CreateObject("scripting.dictionary")
Set Eic = CreateObject("scripting.dictionary")
arr = Sheets("1维").Range("a1").CurrentRegion

For i = 2 To UBound(arr)
    Dic(arr(i, 4)) = ""
Next
ttr = Join(Dic.keys, "")
'MsgBox ttr
ReDim brr(1 To 20000, 1 To 3 + Dic.Count)

For j = 2 To UBound(arr)
    str = arr(j, 1) & "-" & arr(j, 2) & "-" & arr(j, 3)
    x = InStr(ttr, arr(j, 4)) / 2 + 0.5
   
    If Eic.exists(str) Then
        k = Eic(str)
       brr(k, 3 + x) = arr(j, 5)
    Else
        n = n + 1
        Eic(str) = n
        brr(n, 1) = arr(j, 1)
        brr(n, 2) = arr(j, 2)
        brr(n, 3) = arr(j, 3)
        brr(n, 3 + x) = arr(j, 5)
    End If
Next

With Sheets("二维")
    .Cells.ClearContents
    .Columns("b:b").NumberFormatLocal = "@"
    .Range("a1:c1") = Array("班级", "考号", "姓名")
    .Range("d1").Resize(, Dic.Count) = Dic.keys
    .[a2].Resize(n, 3 + Dic.Count) = brr
End With
End Sub

明天会更好zj

一个二维转1维，一个一维转二维

mmwwdd

mmwwdd

最近学SQL什么东西就得想用SQL解决