Excel, VBA, мне нужно отправить rng в последний столбец. В настоящее время MsgBox отображает его

в основном я использую функцию TextToColumns для разделения данных, разделенных точкой с запятой в той же ячейке. Проблема в том, что есть 2 столбца данных, для которых требуется выполнение этой функции, и мне нужно вставить данные без перезаписи.

(легко, впервые с VBA и Excel) это то, что у меня сейчас есть:

Sub Button1_Click()
    Dim rng As Range
    Dim sh As Worksheet

    Set sh = Worksheets("Sheet1")
    With sh

        Set rng = .[Q1]
        Set rng = .Range(rng, .Cells(.Rows.Count, rng.Column).End(xlUp))

        num = Application.WorksheetFunction.Max(Columns("P"))

        rng.Offset(0, 1).Resize(1, num).EntireColumn.Insert

        rng.TextToColumns Destination:=rng, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    End With

    Set sh2 = Worksheets("Sheet1")
    With sh2
        num2 = Application.WorksheetFunction.Max(Columns("P"))

        Dim lastColumn As Integer

        lastColumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count

        MsgBox Replace(Cells(1, lastColumn).Address(False, False), "1", "")

        MsgBox lastColumn

        Set rng = .[W1]
        Set rng = .Range(rng, .Cells(.Rows.Count, rng.Column).End(xlUp))



        rng.TextToColumns Destination:=rng, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    End With
End Sub

Хорошо, поэтому я пытаюсь исправить вручную во второй части rng на W1. rng должен быть следующим пустым столбцом. поэтому lastColumn, использующий MsgBox, ДЕЙСТВИТЕЛЬНО возвращает столбец «W», но я не могу установить для него значение rng (несоответствие типов). ой, а переменная num установлена ​​на количество столбцов, которые мне нужно вставить. мои данные выглядят так:

счет | столбец с; данные нуждаются в разделении | столбец с; данные нуждаются в разделении

5 | 5 наборов данных, разделенных точкой с запятой | не волнует, потому что это конец листа

есть ли более простой способ сделать это? я даже близко?


person dalearyous    schedule 17.04.2013    source источник


Ответы (2)


... Самое простое решение, если я правильно понимаю ваш вопрос ... Почему бы вам просто не создать ТРЕТИЙ столбец, равный Column1 & ";" & Column2, а затем просто выполнить преобразование текста в столбцы в этом единственном столбце ??

Или я что-то упустил ??

person John Bustos    schedule 17.04.2013
comment
О, хороший момент! это лишило бы возможности писать заголовок, но я мог бы смириться с этим. - person dalearyous; 17.04.2013
comment
Рад, что это сработало! - Если это так, не забудьте отметить решение как ответ. - person John Bustos; 17.04.2013
comment
ну, это не так, потому что значения для этого единственного столбца - это просто формула, а не фактические текстовые значения. Кроме того, могу ли я просто сделать макрос и продолжать использовать VBA? - person dalearyous; 17.04.2013

Предполагая, что я правильно понимаю вашу настройку, следующий код должен работать.

Если вы обрабатываете столбцы данных справа налево, вам не нужно беспокоиться об изменении адресных ссылок при вставке столбцов. Это означает, что вы можете использовать один блок кода вставки / преобразования, повторяемый по двум ссылкам на адреса данных, которые, как я предполагал, равны Q1 и R1.

Также обратите внимание, что я добавил смещение к TextToColumns назначению, чтобы избежать перезаписи исходных данных.

Option Explicit

Sub myTextToColumns()
   Dim sh As Worksheet
   Dim rng As Range
   Dim num As Long
   Dim arr As Variant
   Dim i As Long  
   Set sh = Worksheets("Sheet1")
   arr = Array("R1", "Q1")
   num = Application.WorksheetFunction.Max(Columns("P"))
   With sh
       For i = LBound(arr) To UBound(arr)
           Set rng = .Range(arr(i))
           Set rng = .Range(rng, .Cells(.Rows.Count, rng.Column).End(xlUp))
           rng.Offset(0, 1).Resize(1, num).EntireColumn.Insert
           rng.TextToColumns Destination:=rng.Offset(0, 1), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
              Semicolon:=True, Comma:=False, Space:=False, Other:=False, _
              FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
       Next
   End With
End Sub
person chuff    schedule 18.04.2013