數組插入重複的和不重複的數據到VBA中的不同列

Question

美好的一天！在我的工作表中我有(1) textbox as TextBox1和1 button for submit button.我在這裏給出了分割文本作爲輸出的示例代碼。我只是希望如果textbox1中有重複的單詞，並且用戶輸入提交按鈕，它將保存到工作表（DatabaseStorage）和categorize the output從No Duplicated Word和duplicated Word。因爲系統的某些功能需要這兩個不同的字段。

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

這應該完成你所需要的。我遍歷數組以檢查給定值是否存在於「無重複」列中。如果沒有，請不要在那裏打印。

任何時候我遇到一種情況，我需要檢查列表中的單個值（例如檢查重複項，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