Excel VBA Excel перебирает столбцы - PullRequest
0 голосов
/ 27 ноября 2018

Я написал простой сценарий VBA, который открывает все файлы .xls в заданной папке и копирует и вставляет нужную информацию из этих файлов в новый буклет.Каждая строка в новом буклете связана с файлом из папки.Примерно так:

    Column1, Column2, Column3
    FileName1,ABC, XYZ
    FileName2, DEF,TUV

Информация в столбце 3 имеет формат

    "ArbitraryString1(Very_Important_Info)ArbitraryString2"

Поскольку я хотел, чтобы Column3 выглядел хорошо, я перебрал все строки и использовал

Range("C"&X).TextToColumns DataType:=xlDelimited, Other:=True _
OtherChar:="("
Columns("E:E").Insert Shift:=xlToRight *
Range("D"&X).TextToColumn DataType:=xlDelimited, Other:=True _
OtherChar:=")"
Range("C"&X).TextToColumns DataType:=xlDelimited, Other:=True _
OtherChar:="(" **
Columns("E:Z").Delete
Columns("C:C").Delete

В конце этого я получаю

    Column1, Column2, Column3
    FileName1,ABC, Very_Important_Info_1
    FileName2, DEF,Very_Important_Info_2

* Это необходимо, поэтому, когда я вызываю TextToColumn во второй раз, я не получаю сообщение, спрашивающее меня, хочу ли я перезаписать то, что ужев этом столбце.

** По какой-либо причине после вызова OtherChar: = "(" в первый раз я вижу "(Very_Important_Info) ArbitraryString2" с левым параметром, все еще прикрепленным к информации, а не кчтобы это исчезло. Кто-нибудь знает, почему это может быть? Я не против вызова метода во второй раз, но без него мой столбец C выглядел бы как "(Very_Important_Info", и я не понимаю, почему он так получился.

Ответы [ 2 ]

0 голосов
/ 27 ноября 2018

Вот упрощенная версия кода Михала Розы:

Sub BeautifyIt()
    With Worksheets("Sheet1")
        With .Range("C2", .Range("C" & .Rows.Count).End(xlUp))
            .Replace ")", "("
            .TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, _
                           TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                           Semicolon:=False, Comma:=False, Space:=False, Other:=True, _
                           OtherChar:="(", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        End With
    End With
End Sub
0 голосов
/ 27 ноября 2018

Может работать лучше с SPLIT

Sub TextToCols()
    Dim rng As Range
    Dim r As Range
    Dim l As Long
    Dim arr As Variant

    With ActiveSheet
        l = .Cells(.Rows.Count, "C").End(xlUp).Row

        Set rng = Range("C2:C" & l)
        For Each r In rng
            r.Value = Application.WorksheetFunction.Substitute(r.Value, ")", "(")
            arr = Split(r.Value, "(")
            Cells(r.Row, 3).Value = arr(1)
        Next r

    End With
End Sub

Или с текстом в столбцы:

Sub TextToCols()
    Dim rng As Range
    Dim r As Range
    Dim l As Long

    With ActiveSheet
        l = .Cells(.Rows.Count, "C").End(xlUp).Row

        Set rng = Range("C2:C" & l)
        For Each r In rng
            r.Value = Application.WorksheetFunction.Substitute(r.Value, ")", "(")
        Next r

        With .UsedRange.Columns("C").Cells
            .TextToColumns Destination:=Range("C1"), _
            DataType:=xlDelimited, _
            OtherChar:="("
        End With

    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...