将重复数据和非重复数据的数组插入VBA中的不同列

时间:2017-09-05 16:55:55

标签: vba excel-vba excel

美好的一天!在我的工作表中,我有(1) textbox as TextBox11 button for submit button.我这里有示例代码,它将分割文本作为输出。我只是想要,如果textbox1中有重复的单词,并且用户输入了提交按钮,它将保存到工作表(DatabaseStorage)和categorize the output No Duplicated Wordduplicated Word。因为系统的某些功能需要这两个不同的字段。

This how the data input this is from SPLIT worksheet Expected output after submiting the submit button for Worksheet DatabaseStorage

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

1 个答案:

答案 0 :(得分: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