Кодирование VBA: Как скопировать определенный столбец из заголовка вниз до определенного числа строк (изменить для каждого файла Excel) на новый лист в Excel?

Question

Мне действительно нужна помощь в кодировании VBA, так как у меня совершенно нет опыта работы в Excel VBA. Я прочитал некоторые базовые кодирования, но я думаю, что для задачи, которую я хотел выполнить, она намного сложнее для меня. По сути, я хотел скопировать много разных столбцов с заголовками из исходного листа на новый лист, в результате чего я не могу скопировать весь столбец, потому что в определенной строке ниже есть некоторая текстовая информация, которая мне не нужна. Кроме того, количество строк, содержащих информацию о данных, которые мне нужно было изменить для разных файлов Excel, но я бы хотел, чтобы код работал для всех файлов. Возможно ли это?

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

Итак, я хотел столбцы с отправкой, транспортными средствами и доставкой

PS. Фактический файл состоит из множества строк и столбцов и множества нежелательных данных

Sub Sample()
    Dim ws As Worksheet
    Dim aCell As Range, Rng As Range
    Dim col As Long, lRow As Long
    Dim colName As String

    '~~> Change this to the relevant sheet
    Set ws = ActiveWorkbook.Sheets("Sheet 1")

    With ws
        Set aCell = .Range("A1:AZ30").Find(What:="Shipment", LookIn:=xlValues, LookAt:=xlWhole, _
                    MatchCase:=False, SearchFormat:=False)
    '~~> If Found
    If Not aCell Is Nothing Then

    '~~> Copy the entire column >> **how to change this??? I don't want the part e.g. id number to come with values under shipment**
    aCell.EntireColumn.Copy

Answer 1

Вы можете попробовать:

Option Explicit

Sub test()

    Dim strSearch As String
    Dim strFound As Range
    Dim LastRow As Long

    'Assign to strSearch what we are looking for
    strSearch = "Test"

    'Refer to the sheet where data are
    With ThisWorkbook.Worksheets("Sheet1")

        'You could used ".UsedRange" to cover all used range of Sheet1
        Set strFound = .UsedRange.Find(What:=strSearch, LookIn:=xlValues, LookAt:=xlWhole)

        'If we have results
        If Not strFound Is Nothing Then
            'Find the LastRow of the column where the finding is
            LastRow = .Cells(.Rows.Count, strFound.Column).End(xlUp).Row
            .Range(.Cells(strFound.Row + 1, strFound.Column), .Cells(LastRow, strFound.Column)).Copy
        Else
            MsgBox "No match"
        End If

    End With

End Sub

Answer 2

Вам нужно будет сделать несколько циклов, чтобы сделать эту работу.Вот как я бы это сделал для отправки, и вы можете повторить операторы if для других ваших столбцов:

z = 12 'ending row
n = 12 'ending column K
y = 1 'starting column
Do While y <= n
x = 1 'starting row
    Do While x <= z
    If Cells(x, y) = "Shipment" Then
    'Grab that cell's data, perhaps by saying Sheets("OtherSheet").Range("A1") = cells(x,y) or wherever you are looking to put this data.  Insert perhaps another Do loop here to iterate x down until the data reaches an end or until z so that you can grab all the data under "Shipment".
    Else
    End If
    x = x + 1 'go to the next row
    Loop 'ends after z is reached
y = y + 1
Loop 'ends after column K is reached