通过excelvba控制写字板

我有一个包含excel单元格的列，其中多个值之间用“，”或“&”（来自数据库）分隔。如何通过excel VBA控制写字板

样本数据-

1111


1112,12311,2321,12312 & 23123

12321


1111

1115

1123, 12312

1211

1111,2321 & 2321

2321 & 1211

所需的O/p在1列唯一值中没有重复项

到目前为止，我一直在复制工作表中的数据--->删除dup。值-->文本到列-->1。以“&”2分隔。复制第2列中的值，删除dup。和空格--->将其粘贴到原始数据下方--->文本到列--->按“，”分隔--->如果大于1，则按每列复制数据-->在原始数据下方转置和pste

我目前正在尝试通过“^p”（这是我的好朋友建议的，节省了我很多时间）在这里->复制所有原始数据-->删除dup->粘贴到写字板->替换“，”和“&”，并用原始数据替换

我一直到将数据粘贴到写字板中，不知道如何通过excel VBA替换写字板中的数据。有人能帮我吗

            'Create and copying the required range to word
               
                Dim iTotalRows As Integer   ' GET TOTAL USED RANGE ROWS.
                iTotalRows = Worksheets("Quote #").UsedRange.Rows.Count
            
                Dim iTotalCols As Integer   ' GET TOTAL COLUMNS.
                iTotalCols = 2
                
                
                ' WORD OBJECT.
                Dim oWord As Object
                Set oWord = CreateObject(Class:="Word.Application")
                oWord.Visible = True
                oWord.Activate
                
                ' ADD A DOCUMENT TO THE WORD OBJECT.
                Dim oDoc
                Set oDoc = oWord.Documents.Add
                
                ' CREATE A RANGE FOR THE TABLE INSIDE WORD DOCUMENT.
                Dim oRange
                Set oRange = oDoc.Range
            
                ' CREATE AND  DEFINE TABLE STRUCTURE USING
                    ' THE ROWS AND COLUMNS EXTRACTED FROM EXCEL USED RANGE.
                oDoc.Tables.Add oRange, iTotalRows, iTotalCols
            
                ' CREATE A TABLE OBJECT.
                Dim oTable
                Set oTable = oDoc.Tables(1)
                'oTable.Borders.Enable = True
            
                Dim iRows, iCols As Integer
            
                ' LOOP THROUGH EACH ROW AND COLUMN TO EXTRACT DATA IN EXCEL.
                For iRows = 1 To iTotalRows
                    For iCols = 1 To iTotalCols
                        Dim txt As Variant
                        txt = Worksheets("Quote #").Cells(iRows, iCols)
                        oTable.cell(iRows, iCols).Range.Text = txt        ' COPY (OR WRITE) DATA TO THE TABLE.
            
                        ' BOLD HEADERS.
                        'If Val(iRows) = 1 Then
                         '   objTable.cell(iRows, iCols).Range.Font.Bold = True
                        'End If
                    Next iCols
                Next iRows
                
                'to replace text code reference source pasted below
                
                With oWord.ActiveDocument.Content.Find
                .ClearFormatting
                .Replacement.ClearFormatting
                
                .Text = ","
                .Replacement.Text = "^p"
                .wrap = 1 '.Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                .Execute Replace:=2 'reference : - 
                End With
                
                Set oWord = Nothing
                
                 

              

我试图用“^”代替“”，“和”，这个词将被看作是一个新行。希望这有帮助

所需O/p：-

1112

12311

2321

12312

23123

12321

1111

1115

1123

---

1211

好的，根据评论和博文，不需要删除重复项。我建议在这里使用一个。以下情况的示例代码。据我所知，所需的输出应如C列所示

下面的代码将执行此操作

Option Explicit

Sub RemoveDuplicatesFromDBExtract()

Const COMMA = ","
Const AMPERSAND = "&"

Dim i As Long
Dim rg As Range
Dim sngCell As Range
Dim vDat As Variant
Dim vContent As Variant

' Add a reference to the Microsoft Scripting Runtime
' Select Tools->References from the Visual Basic menu.
' Check box beside "Microsoft Scripting Runtime" in the list.
Dim dict As Scripting.Dictionary

    Set dict = New Scripting.Dictionary

    ' Adjust for your need
    Set rg = Range("A1:A9")

    For Each sngCell In rg
        vContent = Replace(sngCell.Value, COMMA, vbCrLf)
        vContent = Replace(vContent, AMPERSAND, vbCrLf)
        vDat = Split(vContent, vbCrLf)

        For i = LBound(vDat) To UBound(vDat)
            On Error Resume Next
            ' If vdat(i) is already in the dictionary it will not be added twice
            dict.Add Trim(vDat(i)), Trim(vDat(i))
            On Error GoTo 0
        Next i

    Next sngCell

    ' Write output, adjust for your needs
    Range("C1").Resize(dict.Count, 1) = WorksheetFunction.Transpose(dict.Items)

End Sub

---

到目前为止你试过什么？任何代码，你可以发布吗？我找到了一个解决方案，但它不正确。那么我如何删除字符并使数字转到下一行？请相应地编辑您的问题。根据代码，这似乎是在Word上，而不是Excel上。@Storax我已经编辑了代码。请告诉我，谢谢。我从未听说过脚本字典。我们一定会尝试实施它，这将节省我们很多时间@Storax。那么让我们希望你不要使用Mac电脑，因为它在这方面不可用。哇，只要试一次，它就成功了：）你太棒了@Storax很高兴我能帮上忙。谢谢