在分割和複製Access VBA中的一部分單元后忽略值

我正在嘗試創建一個新字段，其中包含已格式化的預先存在的字段中的數據。如果在現有領域的單元格中包含以下數據（包括換行符）：在分割和複製Access VBA中的一部分單元后忽略值

╔══════════════════════════╗ 
║  ExistingField  ║ 
╠══════════════════════════╣ 
║ App: Some Name   ║ 
║ App: Another Name  ║ 
║ App: A Different Name ║ 
║ Supplier: Supplier Name ║ 
╚══════════════════════════╝

那麼新領域應如下所示：

╔═════════════════════════╦══════════════════╗ 
║  ExistingField  ║ NewField   ║ 
╠═════════════════════════╬══════════════════╣ 
║ App: Some Name   ║ Some Name  ║ 
║ App: Another Name  ║     ║ 
║ App: A Different Name ║     ║ 
║ Supplier: Supplier Name ║     ║ 
╠═════════════════════════╬══════════════════╣ 
║ App: Some Name   ║ Another Name  ║ 
║ App: Another Name  ║     ║ 
║ App: A Different Name ║     ║ 
║ Supplier: Supplier Name ║     ║ 
╠═════════════════════════╬══════════════════╣ 
║ App: Some Name   ║ A Different Name ║ 
║ App: Another Name  ║     ║ 
║ App: Different Name  ║     ║ 
║ Supplier: Supplier Name ║     ║ 
╚═════════════════════════╩══════════════════╝

這是什麼東西做的是在看後的每個值App:如Some Name。對於單元格中存在的每個值，記錄都將被複制，並且每個值都將存儲在NewField字段中的新記錄中。此表格沒有主鍵，在ExistingField下的單元格中可以有任意數量的App:和Supplier:組合。

我得到的地步，我的代碼將在新行拆分單元格，且重複的記錄，但目前尚不能忽略Supplier:，並與整個App: Some Name而不是僅僅Some Name填充NewField。我怎麼能達到預期的結果？

這是到目前爲止我的代碼：

Public Sub CreateNameField(tableName As String) 

    Dim db As DAO.Database 

    Set db = CurrentDb 

    ' Create NewField field ' 
    Dim strDdl As String 
    strDdl = "ALTER TABLE [" & tableName & "] ADD COLUMN NewField TEXT(255);" 

    Debug.Print strDdl 
    CurrentProject.Connection.Execute strDdl 

    ' Select all fields that have a ExistingField and are unprocessed (NewField is Null) ' 
    strSQL = "SELECT *, NewField " & _ 
      " FROM [" & tableName & _ 
      "] WHERE ([ExistingField] Is Not Null) AND ([NewField] Is Null)" 

    Set rsADD = db.OpenRecordset(tableName, dbOpenDynaset, dbAppendOnly) 

    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset) 

    With rs 
     While Not .EOF 

      ' Split field on newline ' 
      varData = Split(rs![ExistingField], vbCrLf) 

      ' Update First Record ' 
      ' Ensure that varData contains at least one value ' 
      If UBound(varData) > -1 Then 
       .Edit 
       !NewField = Trim(varData(0)) ' Remove spaces before writing new fields ' 
       .Update 
      End If 

      ' Add records with same first field ' 
      ' and new fields for remaining data at end of string ' 
      For i = 1 To UBound(varData) 
       rsADD.AddNew 
       For Each fld In rsADD.Fields 
        If fld.Name <> "NewField" Then 
         ' Copy all fields except "NewField" ' 
         rsADD(fld.Name) = rs(fld.Name) 
        End If 
       Next fld 
       ' NewField is set separately ' 
       rsADD!NewField = Trim(varData(i)) ' Remove spaces before writing new fields ' 
       rsADD.Update 
      Next i 

      .MoveNext 
     Wend 

     .Close 
     rsADD.Close 

    End With 

    Set rsADD = Nothing 
    Set rs = Nothing 
    db.Close 
    Set db = Nothing 

End Sub

來源

2016-07-27 Paradox

你需要從斯普利特（）數組中的測試每個元素：

Dim newVal 
If varData(i) Like "App: *" Then 
    newVal = Replace(varData(i),"App: ", "") 
    'add the new record using newVal 
End if

來源

2016-07-27 17:38:20

在分割和複製Access VBA中的一部分單元后忽略值

回答

相關問題