Скопируйте и вставьте динамически изменяемый столбец со значениями из одного рабочего листа в другой.

Question

Я пытаюсь создать макрос для копирования и вставки столбца из вывода данных с одного рабочего листа под названием ImportTXT в таблицу на другом листе под названием ExtractData , но этот столбец может be Dynami c, и количество точек может измениться (то есть, сколько номеров точек (1,2,3, ...), а также сколько итераций каждой точки (в данном случае есть 9 точек Комбинации 1, 9 точек 2, 9 точек 3 и т. Д. c.)). Это означает, что код должен работать для любого файла аналогичного типа, но переменного размера.

Вот несколько фотографий для справки:

Первое изображение показывает, как выглядят данные из листа ImportTXT . Для справки: первая ячейка всегда будет в ячейке «A51».

Данные в столбце ImportTXT

Второе изображение показывает мою цель для внешнего вида таблицы на листе «ExportData». Первая ячейка, в которую должны быть вставлены данные, всегда будет «C8».

Окончательный вид столбца в таблице

Вот макрос, который я записал в попробуйте выбрать все числа только в столбце № точки:

Sub SelectPointNoCol()
'
' SelectPointNoCol Macro
' Selects Point No Column and pastes it in the corresponding column in the table.

    Sheets("ImportTXT").Select
    Range("A51").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.SpecialCells(xlCellTypeConstants, 23).Select
    Selection.Copy
    Sheets("ExtractData").Select
    Range("C8").Select
    ActiveSheet.Paste

End Sub

К сожалению, этот метод выбора дает мне ошибку во время выполнения, и я не уверен, как ее исправить. После прохождения кода один за другим, похоже, что на моем компьютере код Range(Selection, Selection.End(xlToLeft)).Select не выполняет свою работу по выбору только столбца № точки. Мой процесс заключался в следующем: выберите ячейку A51 на листе ImportTXT , выберите Ctrl + Shift + End, затем дважды Ctrl + Shift + стрелка влево (<-), затем на вкладке Home нажмите Find & Select, GoToSpecial, отметьте «константы», затем скопируйте и вставьте числа в столбец PointNo на листе <em>ExtractData .

Примечание: Номер точки не совсем относится к остальным данным, это просто маркер, а также может быть буква, например A, B, C, et c. но числа использовались только что.

Спасибо заранее.

Answer 1

@ Matcha22 Хорошо, если числа из ImportTXT на самом деле не относятся к остальным данным в ExtractData, и вы просто хотите, чтобы список чисел был в порядке с удаленными пробелами, вам не нужно использовать VBA, чтобы сделать это, вы можете просто скопировать / вставить числа, а затем отсортировать значения, чтобы удалить пустые строки.

Вот как вы это делаете:

Теперь, если вы хотите, чтобы это происходило автоматически без копирования и вставки значений вручную, для этого потребуется VBA.

EDIT: @ Matcha22 на основе ваших обновлений исходного сообщения, я так понимаю, вы хотите, чтобы это происходило автоматически, для чего потребуется код VBA.

Я придумал код, который сделает это за вас. Вот подробное описание того, что он делает:

1. начинается с определенной начальной точки в ImportTxt
2. идет вниз от этой начальной точки и находит ячейку, которая содержит последнее значение в списке, которое нужно скопировать и вставить в ExtractData. Это определяется как первая строка в столбце, за которой следуют 2 строки, где значение пустое. (ваши значения для Point No. указаны в каждой второй строке, поэтому за последним значением будут следовать 2 пустые строки вместо 1)
3. берет этот диапазон и копирует его
4. вставляет значения в ExtractData, где вы определяете для его вставки
5. сортирует значения для удаления пустых строк

для кода, который вам нужен для определения столбца и строки, которые вы хотите для начала в ImportTxt, а также столбец и строка, в которые вы хотите вставить результаты, в ExtractData

Вот код, он должен работать для вас:

    Dim ImportTxtRowNumStart As Integer
    Dim ImportTxtRowNumEnd As Integer
    Dim foundTargetRow As Boolean
    Dim ImportTxtCol As String

    foundTargetRow = False

    ImportTxtCol = "A" ' the column in ImportTxt where Point No is
    ImportTxtRowNumStart = 51 ' the row in ImportTxt where Point No starts
    ImportTxtRowNumEnd = ImportTxtRowNumStart

    Do
        If Sheets("ImportTXT").Range(ImportTxtCol + CStr((ImportTxtRowNumEnd + 1))).Value = "" And Sheets("ImportTXT").Range(ImportTxtCol + CStr((ImportTxtRowNumEnd + 2))).Value = "" Then
            foundTargetRow = True
        Else
            ImportTxtRowNumEnd = ImportTxtRowNumEnd + 1
        End If
    Loop While foundTargetRow = False


   Dim ExportDataColumn As String
   Dim ExportDataRow As Integer

   ExportDataColumn = "C" ' the column in ExportData where values go
   ExportDataRow = 8 ' the row in ExportData where values go

   Range(ImportTxtCol + CStr(ImportTxtRowNumStart) + ":" + ImportTxtCol + CStr(ImportTxtRowNumEnd)).Select
   Selection.Copy
   Sheets("ExtractData").Select
   Range(ExportDataColumn + CStr(ExportDataRow)).Select
   ActiveSheet.Paste
   Application.CutCopyMode = False
   ActiveWorkbook.Worksheets("ExtractData").Sort.SortFields.Clear
   ActiveWorkbook.Worksheets("ExtractData").Sort.SortFields.Add2 Key:=Range(ExportDataColumn + CStr(ExportDataRow)), _
       SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   With ActiveWorkbook.Worksheets("ExtractData").Sort
       .SetRange Range(ExportDataColumn + CStr(ExportDataRow) + ":" + ExportDataColumn + CStr(ExportDataRow + (ImportTxtRowNumEnd - ImportTxtRowNumStart)))
       .Header = xlNo
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
   End With

Вот как это выглядит при запуске:

Если это не сработает, если у вас есть другие вопросы о том, как это реализовать, пожалуйста, позвольте мне знаю.

Надеюсь, это поможет!