У меня есть столбец с ячейками Excel с несколькими значениями, разделенными "," или "&" (из БД).Как управлять WordPad через Excel VBA? - PullRequest
0 голосов
/ 15 октября 2018

Пример данных -

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 ниже оригиналаdata.

Я сейчас пытаюсь добиться здесь -> скопировать все исходные данные -> удалить dup -> вставить в wordpad -> заменить ',' и '&' на '^ p' (это было предложеномоим хорошим другом и экономит мне много времени) и заменить на исходные данные.

Я дошел до вставки данных в Wordpad и не знаю, как заменить данные в WordPad через 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

Я пытаюсь заменить "," или "&" на "^ p", слово которого будет считаться новой строкой.Надеюсь, это поможет.

Требуется O / P: -

1112

12311

2321

12312

23123

12321

1111

1115

1123

1211

1 Ответ

0 голосов
/ 15 октября 2018

Хорошо, основываясь на комментариях и посте Word, не нужно удалять дубликаты.Я предлагаю использовать словарь здесь.Пример кода для следующей ситуации.В моем понимании желаемый вывод должен быть таким, как в столбце C

enter image description here

Следующий код сделает это

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...