重複したデータをVBAの異なる列に挿入する

Question

おはよう！私のワークシートには(1) textbox as TextBox1と1 button for submit button.があります。出力として分割されたテキストを与えるサンプルコードがあります。テキストボックス1に重複した単語があり、ユーザーが送信ボタンを入力するとワークシート（DatabaseStorage）に保存され、categorize the outputはNo Duplicated Wordからduplicated Wordに保存されます。この2つの異なるフィールドは、システムの一部の機能に必要となるためです。

Private Sub CommandButton1_Click() 
Call SplitText 
End Sub 
Sub SplitText() 
Dim WArray As Variant 
Dim TextString As String 
TextString = TextBox1 
WArray = Split(TextBox1, " ") 
If (TextString = "") Then 
MsgBox ("Error: Pls Enter your data") 
Else 


With Sheets("DatabaseStorage") 
    .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(WArray) + IIf(LBound(WArray) = 0, 1, 0)) = Application.Transpose(WArray) 
End With 

MsgBox ("Successfully inserted") 

End If 

End Sub 

Answer 1

これは、あなたが必要なものを達成する必要があります。配列をループして、指定された値が "No Duplicates"列に存在するかどうかを確認します。そうでない場合は、そこに印刷しないでください。

リスト（たとえば重複、GT/LTなどのチェック）に対して単一の値をチェックする必要がある状況に遭遇するたびに、ループを検討します。

Sub SplitText() 
Dim WArray As Variant 
Dim TextString As String 
Dim col_no_dup As Long 
Dim col_dup As Long 
Dim counter As Integer 
Dim sht_database As Worksheet 

With ThisWorkbook 
    Set sht_database = .Sheets("DatabaseStorage") 
    TextString = LCase(.Sheets("Sheet1").Shapes("Textbox1").DrawingObject.Text) 
End With 

WArray = Split(TextString, " ") 'load array 

If (TextString = "") Then 
    MsgBox ("Error: Pls Enter your data") 
    End 
Else: End If 

'set column locations for duplicates/no duplicates 
col_no_dup = 1 
col_dup = 2 

With sht_database 
    .Range("A2:B10000").ClearContents 'clear existing data. Change this as needed 

    'Print whole array into duplicates column 
    .Cells(Cells.Rows.Count, col_dup).End(xlUp).Offset(1, 0).Resize(UBound(WArray) + IIf(LBound(WArray) = 0, 1, 0)) = Application.Transpose(WArray) 

    'Loop through array 
    For i = LBound(WArray) To UBound(WArray) 
     counter = 0 
     lrow_no_dup = .Cells(Cells.Rows.Count, col_no_dup).End(xlUp).Row 
     For n = 1 To lrow_no_dup 'loop through and check each existing value in the no dup column 
      If .Cells(n, col_no_dup).Value = WArray(i) Then 
       counter = counter + 1 'account for each occurence 
      Else: End If 
     Next n 
     If counter = 0 Then 'counter = 0 implies the value doesn't exist in the "No Duplicates" column 
      .Cells(lrow_no_dup + 1, col_no_dup).Value = WArray(i) 
     Else: End If 
    Next i 

End With 

MsgBox ("Successfully inserted") 

End Sub