将一列按条件填入指定区域

ckh2004

如题，每学期开学都要做的一件事，烦请老师帮忙。将姓名填入相应区域内。谢谢！

蓝桥玄霜

请见代码。

ckh2004

蓝桥玄霜 发表于 2018-2-19 16:07
请见代码。

老师：我输入了代码，没能成功，可以发个附件吗？

abc123281

呵呵   那可能是你照抄代码有错误     调试看看

ckh2004

认真对了一遍，好像没输入错啊

abc123281

那你就要调试看看

abc123281

把你抄好代码的附件传上来我们看

ckh2004

Sub lqxs()
    Dim arr, i&, aa, j&, n&, m&, col%, ks&
    Dim d, k, t, d1
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scripting.dictionary")
    Sheet1.Activate: n = 1
    [a2:m500].ClearContents
    arr = Sheet2.[a1].CurrentRegion
    For i = 2 To UBound(arr)
        If arr(i, 5) <> "" Then
            d(arr(i, 5)) = d(arr(i, 5)) & i & ","
        Else
            If d(arr(i, 3)) <> "" And IsNumeric(arr(i, 3)) Then d(arr(i, 3) & "年级") = d(arr(i, 3) & "年级") & i & ","
        End If
    Next
    k = d.keys: t = d.items
    For i = 0 To UBound(k)
        n = n + 1: col = 2: m = 0
        Cells(n, 2) = k(i): ks = n
        t(i) = Left(t(i), Len(t(i)) - 1)
        If InStr(t(i), ",") Then
            aa = Split(t(i), ",")
            For j = 0 To UBound(aa)
                If Not d1.exists(arr(aa(j), 2)) Then
                    d1(arr(aa(j), 2)) = ""
                    col = col + 1: m = m + 1
                    If col > 13 Then col = 3: n = n + 1
                    Cells(n, col) = arr(aa(j), 2)
                    End If
              Next
              Cells(ks, 1) = m
           Else
            Cells(n, 3) = arr(t(i), 2): Cells(n, 1) = 1
        End If
   Next
   End Sub

abc123281

呵呵
    If d(arr(i, 3)) <> "" And IsNumeric(arr(i, 3)) Then d(arr(i, 3) & "年级") = d(arr(i, 3) & "年级") & i & ","
以上这句错误   改成下面的
   If arr(i, 3) <> ""

abc123281

代码还算抄写认真
   已经很不错了   错误极少   初学者照抄代码错误是正常的
我曾经也是这样的