用於檢查數據一致性的Excel字符串處理

Question

背景信息： - 有近7000個人，並且在一個，兩個或三個測試中有關於他們的表現的數據。

每個人都參加了第一次測試（我們稱之爲測試M）。其中一些誰採取試驗M也紛紛採取測試我，有的那些誰採取考試的我也採取試驗B。

對於前兩個測試（M和I），學生可以得分等級I，II或III。根據他們的等級，他們被授予分 - 3級爲一級，2級爲二級，1級爲III。

最後一次測試B僅僅是合格或不合格的結果，沒有成績。那些通過這個測試得到1分，沒有失敗的積分。 （實際上，成績是可以獲得的，但所有成績都有一個共同的1分）。

業餘已輸入數據來表示這些學生和他們的成績在Excel文件中。問題是，這個人已經做了最糟糕的事情 - 他已經開發了他自己的符號並在一個單元格中輸入了所有的測試信息---並使我的生活變得糟糕透了。

文件原本有兩個文本列，一個人的ID，第二個測試信息，如果可以稱呼它。

alt text http://i48.tinypic.com/5tv0bl.png這太可怕了，我知道了，我很痛苦。在圖中，如果您看到「M-II-2 I-III-1」，則表示該人在測試M中獲得2分2分，在測試1中獲得1分1分。有些人只做了一次測試，兩次，三次。

當文件來找我的處理和分析學生的表現，我把它送回與指令插入額外的3列只與牌號爲三項測試。該文件現在看起來如下所示。列C和D分別表示使用1,2和3的等級I，II和III。列C是試驗M，用於測試一列列dé說，BA（B實現的！）如果個人已經通過測試B.現在，你有上述信息

alt text http://i50.tinypic.com/16c0yvr.png

，讓我們開始問題。我不相信這一點，並要檢查B列中的數據是否與也就是說，我要檢查B列字符串中列C，d和E

數據匹配，找出是否在列中的數字C，D和E是正確的。

所有的幫助真的很感謝。

P.S. - 我通過ODBC將它導出到MySQL，這就是爲什麼你看到這些NULL。我也嘗試過在MySQL中這樣做，並且真的會接受MySQL或Excel解決方案，我沒有偏好。

Edit : - See file with sample data

Answer 1

從原始數據創建一個平面文件：

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