Excel VBA - поиск столбцов по заголовку и вставка в новый лист - PullRequest
Новая
       33

Excel VBA - поиск столбцов по заголовку и вставка в новый лист

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

Я новичок в VBA ... пытаюсь найти определенные столбцы по имени и вставить их в новый лист.

То, что у меня есть, кажется неуклюжим и не копирует и не вставляет нужный столбец, а то, что у меня есть в буфере обмена!

В идеале я бы смог найти 3 разных столбца и вставить их на новый лист.

Любая помощь будет принята с благодарностью 

Dim CheckText As String
Dim CheckRow As Long
Dim FindText As Range
Dim CopyColumn As String
CheckText = “Bsp” 'Bsp is an example header
CheckRow = 1 'Row with desired header
Dim oldsheet As Worksheet

Set oldsheet = ActiveSheet
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Pivot"
oldsheet.Activate
ActiveSheet.Select
'trying here to create a new sheet, name it and go back to the first sheet
Set FindText = Rows(CheckRow).Find(CheckText)
If FindText Is Nothing Then
MsgBox "Bsp not found"
End If

CopyColumn = Cells(CheckRow, FindText.Column).Column
Columns(CopyColumn).Select.Copy

Sheets("Pivot").Select

ActiveSheet.Paste

Ответы [ 2 ]

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

В итоге я использовал этот код в попытке найти другой заголовок, скопировать и вставить его Опция Явная 

Sub Test()


Dim ws As Worksheet

Set ws = ActiveSheet
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Pivot"
ws.Activate
ActiveSheet.Select

Dim LRow As Long, Found As Range

Set Found = ws.Range("A1:EM1").Find("Bsp") '<== Header name to search for


If Not Found Is Nothing Then
LRow = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
ws.Range(ws.Cells(1, Found.Column), ws.Cells(LRow, Found.Column)).Copy
Sheets("Pivot").Range("A1").PasteSpecial xlPasteValues '<== Sheet to paste data
End If

ws.Activate
ActiveSheet.Select

Set Found = ws.Range("A1:EM1").Find("Sog")

If Not Found Is Nothing Then
LRow = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
ws.Range(ws.Cells(1, Found.Column), ws.Cells(LRow, Found.Column)).Copy
Sheets("Pivot").Range("B1").PasteSpecial xlPasteValues

End If

End Sub
0 голосов
/ 04 ноября 2018

Это просто общий пример, который вы можете настроить в соответствии со своими потребностями. Код будет искать заголовок столбца с именем Some String. ЕСЛИ этот столбец найден, затем мы определяем последнюю строку, копируем столбец (до последней строки) и затем вставляем столбец в ячейку A1 на листе Pivot.

  1. Используйте переменную диапазона Found для хранения свойств заголовка вашего столбца (а именно местоположения)
  2. Проверьте, действительно ли найден заголовок! If Not Found is Nothing (Перевод: найдено)
  3. Используйте Found.Column для ссылки на индекс столбца, который хорошо вписывается в свойство Cells, так как синтаксис Cells(Row Index, Column Index)
Option Explicit

Sub Test()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<== Sheet that has raw data
Dim LRow As Long, Found As Range

Set Found = ws.Range("A1:Z1").Find("Some String") '<== Header name to search for

If Not Found Is Nothing Then
    LRow = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
    ws.Range(ws.Cells(1, Found.Column), ws.Cells(LRow, Found.Column)).Copy
    Sheets("Pivot").Range("A1").PasteSpecial xlPasteValues '<== Sheet to paste data
End If

End Sub

Вы хотите изменить некоторые параметры метода Range.Find. Подробности можно найти здесь

...