分割後の値を無視し、Access VBAでセルの一部のみを複製する

Question

書式設定された既存のフィールドのデータを含む新しいフィールドを作成しようとしています。既存のフィールドのセルは（改行文字を含む）以下のデータが含まれている場合：

╔══════════════════════════╗ 
║  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 ║     ║ 
╚═════════════════════════╩══════════════════╝ 

をした後、それぞれの値を見ているこれはやっています例えば、Some NameのようなApp:である。セルに存在する値のそれぞれについて、レコードは複製され、各値は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 

Answer 1

あなたは、スプリット（から配列の各要素をテストする必要があります）：

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