如何从文化户口簿将外县外省就读初中的学生信息导入初中在外寄读花名册

xiangbaoan

笨鸟168 发表于 2018-9-16 20:24
非常感谢！能正常运行，效果非常好，学习了！我修改了个别参数就成了小学、初中、高中的寄读生名册 ...

    If Left(ar(r, 42), 1) = "外" And Right(ar(r, 42), 4) = "中、高职" Then
'改原来的2 为 4 。中、高职  它们有4个字符。我一看，你对我的代码理解得相当到位，赞，进步大！

笨鸟168

xiangbaoan 发表于 2018-9-16 21:50
If Left(ar(r, 42), 1) = "外" And Right(ar(r, 42), 4) = "中、高职" Then
'改原来的2 为 4 。中、 ...

果然改2为4数据就导过来了，谢谢！

笨鸟168

笨鸟168 发表于 2018-9-16 20:24
非常感谢！能正常运行，效果非常好，学习了！我修改了个别参数就成了小学、初中、高中的寄读生名册 ...

      出现了运行时错误“1004”，试了几种方法都解决不了，只有生成0-3岁的周岁册，请帮忙看看是哪里出了问题？谢谢！

xiangbaoan

笨鸟168 发表于 2018-9-17 22:03
出现了运行时错误“1004”，试了几种方法都解决不了，只有生成0-3岁的周岁册，请帮忙看看是哪里出 ...

……请测试反馈……
更新了附件，因审核，在此补充

笨鸟168

能得到想要的结果了，谢谢帮助！

xiangbaoan

Sub 提取0_22岁() '请用这种方法，请测试……
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Dim rng As Range, lr&, r&, i%, ar, y%, ymd As Date, d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("文化户口簿")
    Set rng = .[a1].Resize(6, 41)
    lr = .[g65536].End(3).Row
    ar = .Range("g1:g" & lr)
    For r = 7 To UBound(ar) Step 2
        ymd = ar(r, 1)
        If Len(ymd) Then
            y = 2018 - Year(ymd) - IIf(Month(ymd) > 8, 1, 0)
            If y = 5 Then Debug.Print r
            If y < 23 Then
                If Not d.exists(y) Then
                    Set d(y) = .Cells(r, 1).Resize(2, 41)
                Else
                    Set d(y) = Union(d(y), .Cells(r, 1).Resize(2, 41))
                End If
            End If
        End If
    Next
End With
With Sheets("周岁花名册")
    .Cells.Clear
    rng.Copy .[a1]
    r = 7
    For i = 0 To 22
        If d.exists(i) Then d(i).Copy .Range("a" & r)
        r = .[a65536].End(xlUp).Row + 2
    Next
    .Cells.EntireColumn.AutoFit
End With
Set rng = Nothing
Set d = Nothing
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub