如何将两个DBF文件导入到相应的工作薄对应的工作表中

yzyyyyyyy

如何将两个DBF文件导入到相应的工作薄对应的工作表中1018.rar (17.36 KB, 下载次数: 10)

2012-10-18 15:34 上传

点击文件名下载附件

zhaogang1960 发表于 2012-10-16 17:52
请看附件

感谢版主的热心帮助，解决了大难题，现再次请求帮助，
第6个按钮：（独立程序）
根据下发学籍号表中的学籍号（无学籍号的不用查询）从学生库和家长库（DBF）中查询出，学籍号、姓名、性别、输入班级、联系电话、监护人1电话、监护人2电话，有，G到M列写入相应数据；没有，填写缺录；比较查询出的学籍号、姓名、性别、输入班级与A、D、E、F数据，不一致，则N到Q列写入有误（写入下发学籍表中）。
第7个按钮：（独立程序）在第6个按钮基础上，比较有误的各项写入输入错误表，并标明错误类型（写入输入错误表）；填写统计表中A到G列的统计数据（写入统计表）。
第8个按钮：生成学籍信息校对表，和前5个按钮一样，先选择届别，再生成，要按照下发学籍编号表中的B列数据为单位分页生成。(要求在学籍信息校对表样表)

zhaogang1960

yzyyyyyyy 发表于 2012-10-18 10:52
感谢版主的热心帮助，解决了大难题，现再次请求帮助，
第6个按钮：（独立程序）
根据下发学籍号表中的学 ...

没有看懂，请说明原始数据是什么，你要什么效果，用两个工作表或区域表示

zhaogang1960

你重新上传附件的输入错误表、下发学籍编号两个表字段前后不一致
请说明原始数据和你要求达到的效果

yzyyyyyyy

zhaogang1960 发表于 2012-10-18 11:25
你重新上传附件的输入错误表、下发学籍编号两个表字段前后不一致
请说明原始数据和你要求达到的效果

感谢版主的热心无私的帮助，31楼已重新上传附件

zhaogang1960

yzyyyyyyy 发表于 2012-10-18 15:54
感谢版主的热心无私的帮助，31楼已重新上传附件

右边的还没有写好:

1. Sub 下发学籍编号()
   
2.     Dim cnn As Object, rs As Object
   
3.     Dim SQL As String, arr, brr$(), crr$(), drr(), i&, l&, j&, n&, t, s$, d As Object, ds As Object
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set ds = CreateObject("scripting.dictionary")
   
6.     Set cnn = CreateObject("ADODB.Connection")
   
7.     cnn.Open "Driver={Microsoft Visual FoxPro Driver};SourceType=DBF;SourceDB=" & ThisWorkbook.Path & ";Exclusive=No;"
   
8.     Set rs = CreateObject("ADODB.Recordset")
   
9.     SQL = "select 学籍编号,姓名,性别,班级,联系电话 from z221801"
   
10.     rs.Open SQL, cnn, 1, 3
    
11.     With Sheets("下发学籍编号")
    
12.         ReDim brr(1 To rs.RecordCount, 4)
    
13.         For i = 1 To rs.RecordCount
    
14.             For j = 0 To 4
    
15.                 brr(i, j) = rs.Fields(j).Value
    
16.             Next
    
17.             d(brr(i, 0)) = i
    
18.             rs.MoveNext
    
19.         Next
    
20.         SQL = "select 学籍编号,电话 from zj221800"
    
21.         Set rs = CreateObject("ADODB.Recordset")
    
22.         rs.Open SQL, cnn, 1, 3
    
23.         ReDim crr(1 To rs.RecordCount, 2)
    
24.         For i = 1 To rs.RecordCount Step 2
    
25.             m = m + 1
    
26.             n = 0
    
27.             crr(m, 0) = rs.Fields(0).Value
    
28.             ds(crr(m, 0)) = m
    
29.             For l = i To i + 1
    
30.                 n = n + 1
    
31.                 crr(m, n) = rs.Fields(1).Value
    
32.                 rs.MoveNext
    
33.             Next l
    
34.         Next i
    
35.         arr = Range("A2:F" & Range("A65536").End(xlUp).Row)
    
36.         ReDim drr(1 To UBound(arr), 1 To 11)
    
37.         For i = 1 To UBound(arr)
    
38.             t = d("" & arr(i, 1))
    
39.             t2 = ds("" & arr(i, 1))
    
40.             If t <> "" And t2 <> "" Then
    
41.                drr(i, 1) = brr(t, 4)
    
42.                drr(i, 2) = crr(t, 1)
    
43.                drr(i, 3) = crr(t, 2)
    
44.                drr(i, 4) = brr(t, 0)
    
45.                drr(i, 5) = brr(t, 1)
    
46.                drr(i, 6) = brr(t, 3)
    
47.                drr(i, 7) = brr(t, 2)
    
48.             Else
    
49.                 For j = 1 To 7
    
50.                     drr(i, j) = "缺录"
    
51.                 Next
    
52.             End If
    
53.         Next
    
54.         .Range("g2").Resize(i - 1, 11) = drr
    
55.     End With
    
56.     rs.Close
    
57.     cnn.Close
    
58.     Set rs = Nothing
    
59.     Set cnn = Nothing
    
60. End Sub
    
61. 
    

复制代码

zhaogang1960

请看附件
如何将两个DBF文件导入到相应的工作薄对应的工作表中1018.rar (25.47 KB, 下载次数: 19)

2012-10-18 19:08 上传

点击文件名下载附件

zhaogang1960

右边要求:

1. Sub 下发学籍编号()
   
2.     Dim cnn As Object, rs As Object
   
3.     Dim SQL As String, arr, brr$(), crr$(), drr(), i&, l&, j&, n&, t, s$, d As Object, ds As Object
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set ds = CreateObject("scripting.dictionary")
   
6.     Set cnn = CreateObject("ADODB.Connection")
   
7.     cnn.Open "Driver={Microsoft Visual FoxPro Driver};SourceType=DBF;SourceDB=" & ThisWorkbook.Path & ";Exclusive=No;"
   
8.     Set rs = CreateObject("ADODB.Recordset")
   
9.     SQL = "select 学籍编号,姓名,性别,班级,联系电话 from z221801"
   
10.     rs.Open SQL, cnn, 1, 3
    
11.     With Sheets("下发学籍编号")
    
12.         ReDim brr(1 To rs.RecordCount, 4)
    
13.         For i = 1 To rs.RecordCount
    
14.             For j = 0 To 4
    
15.                 brr(i, j) = rs.Fields(j).Value
    
16.             Next
    
17.             d(brr(i, 0)) = i
    
18.             rs.MoveNext
    
19.         Next
    
20.         SQL = "select 学籍编号,电话 from zj221800"
    
21.         Set rs = CreateObject("ADODB.Recordset")
    
22.         rs.Open SQL, cnn, 1, 3
    
23.         ReDim crr(1 To rs.RecordCount, 2)
    
24.         For i = 1 To rs.RecordCount Step 2
    
25.             m = m + 1
    
26.             n = 0
    
27.             crr(m, 0) = rs.Fields(0).Value
    
28.             ds(crr(m, 0)) = m
    
29.             For l = i To i + 1
    
30.                 n = n + 1
    
31.                 crr(m, n) = rs.Fields(1).Value
    
32.                 rs.MoveNext
    
33.             Next l
    
34.         Next i
    
35.         arr = .Range("A2:F" & .Range("A65536").End(xlUp).Row)
    
36.         ReDim drr(1 To UBound(arr), 1 To 11)
    
37.         For i = 1 To UBound(arr)
    
38.             t = d("" & arr(i, 1))
    
39.             t2 = ds("" & arr(i, 1))
    
40.             If t <> "" And t2 <> "" Then
    
41.                drr(i, 1) = brr(t, 4)
    
42.                drr(i, 2) = crr(t, 1)
    
43.                drr(i, 3) = crr(t, 2)
    
44.                drr(i, 4) = brr(t, 0)
    
45.                drr(i, 5) = brr(t, 1)
    
46.                drr(i, 6) = brr(t, 3)
    
47.                drr(i, 7) = brr(t, 2)
    
48.                If arr(i, 4) <> drr(i, 5) Then drr(i, 9) = "有误"
    
49.                If arr(i, 6) <> drr(i, 6) Then drr(i, 10) = "有误"
    
50.                If arr(i, 5) <> drr(i, 7) Then drr(i, 11) = "有误"
    
51.             Else
    
52.                 For j = 1 To 7
    
53.                     drr(i, j) = "缺录"
    
54.                 Next
    
55.                 For j = 8 To 11
    
56.                     drr(i, j) = "有误"
    
57.                 Next
    
58.             End If
    
59.         Next
    
60.         .Range("g2").Resize(i - 1, 11) = drr
    
61.     End With
    
62.     rs.Close
    
63.     cnn.Close
    
64.     Set rs = Nothing
    
65.     Set cnn = Nothing
    
66. End Sub
    
67. 
    

复制代码

zhaogang1960

请看附件
如何将两个DBF文件导入到相应的工作薄对应的工作表中1018.rar (26.96 KB, 下载次数: 32)

2012-10-18 21:34 上传

点击文件名下载附件

yzyyyyyyy

如何将两个DBF文件导入到相应的工作薄对应的工作表中1022.rar (39.18 KB, 下载次数: 6)

2012-10-22 11:35 上传

点击文件名下载附件

zhaogang1960 发表于 2012-10-18 21:34
请看附件

感谢版主的再次帮助，解决了又一难题，真诚感谢。
请版主帮助解决以下问题：
1、从DBF数据库中导入的数据可能由于原始数据库DBF字段的原因，很多字段内容后面有很多多余的空格，如，导入的姓名中有多余的空格，与下发学籍表中的姓名比对时，下发学籍表中的姓名后没有多余的空格，而导入的姓名中有多余的空格，造成输入错误现象，如如何避免呢。
2、如何生成输入错误表，即列出下发学籍表中右边的出错信息，每个错误一行，若某个学生出现2个错误，则写2行；如何生成统计表中的A到G列数据，统计人数，
3、如何选择届别后，生成学籍信息校对表，按下发学籍表中的班级（B列）打印，每页4人，页码为班级-页码，下发班级校对，各班间换页不连在一起，即以班级为单位打印。（原始表相当于2个DBF文件和下发学籍表中的A到F列，用其中的B列班级数据）

zhaogang1960

yzyyyyyyy 发表于 2012-10-19 15:14
感谢版主的再次帮助，解决了又一难题，真诚感谢。
请版主帮助解决以下问题：
1、导入的数据可能由于原 ...

我理解能力有限，没有看懂