Копирование столбца на основе значения ячейки

Question

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

Так «Сита» имеет в ячейке A1 значение «3-2014» (месяц значение может измениться)

Лист «SheetB» содержит базу данных, которая выглядит примерно так:

2-2014 3-2014 4-2014

значение значения значения б в

значения d значения е значение е

Так что теперь я хотел бы, чтобы скопировать столбец, который содержит «3-2014 "на лист" SheetC ".

Результат будет в "SheetC, колонка 1"

3-2014

значение б

значение е

Я смотрел и пытался, но не смог найти ответ, действительно надеюсь, что кто-то может мне помочь.

С наилучшими пожеланиями к 2015 году и thnx!

С наилучшими пожеланиями,

Джим

Answer 1

вы могли бы использовать ГПР.

В "SheetC, колонка 1" в forumulas будет

=HLOOKUP(SheetA!$A$1,SheetB!$A$1:$C$3,1,FALSE) 
=HLOOKUP(SheetA!$A$1,SheetB!$A$1:$C$3,2,FALSE) 
=HLOOKUP(SheetA!$A$1,SheetB!$A$1:$C$3,3,FALSE) 

Да?

Я знаю, что это не COPY столбец, но я подозреваю, что это то, что вы хотели?

Или вот УВА

sub a 

    Dim ashtEntry As Worksheet 
    Dim ashtDatabase As Worksheet 
    Dim ashtResult As Worksheet 

    Dim DbCell As Range 
    Dim ResultCell As Range 
    Dim rngDatabase As Range 
    Dim rngEntry As Range 

    Set ashtEntry = Worksheets("SheetA") 
    Set ashtDatabase = Worksheets("SheetB") 
    Set ashtResult = Worksheets("SheetC") 

    Set rngEntry = ashtEntry.Range("A1") 
    Set rngDatabase = ashtDatabase.Range("$A$1:$C$3") 

    For Each DbCell In rngDatabase.Rows(1).Cells 

     If DbCell.Value = rngEntry.Value Then 

      With ashtResult.Range("$A$1:$A$3") 
       .Cells(1) = DbCell.Value 
       .Cells(2) = DbCell.Offset(1, 0).Value 
       .Cells(3) = DbCell.Offset(2, 0).Value 
      End With 

      MsgBox "OK" 

      Exit For 

     End If 

    Next 


End Sub 

Answer 2

Это должно быть сделано с помощью VBA?

Я хотел бы использовать в SheetC, A1:

=INDEX(SheetB!$A1:$C1,MATCH(SheetA!$A$1,SheetB!$A$1:$C$1,0)) 

и перетащить его вниз ...

Надеется, что это работает!

Answer 3

Благодарим за предложение. Я уже много работал над своей проблемой и придумал следующее решение;

Sub ImportFromDatabase() 

    strSearch1 = Sheets("manual").Range("C11") 

    Const fromFile = "otherfile.xlsm" 

    Dim srcBook As Workbook 
    Set srcBook = Application.Workbooks.Open(fromFile, _ 
     UpdateLinks:=False, _ 
     ReadOnly:=True, _ 
     AddToMRU:=False) 

     Application.DisplayAlerts = False 

    With wrkbk 
     Set Value1 = srcBook.Sheets("DAx_data").Rows(3).Find(What:=strSearch1, LookIn:=xlValues, _ 
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
      MatchCase:=False, SearchFormat:=False) 

      srcBook.Sheets("DAx_data").Columns(Value1.Column).Copy 
      ThisWorkbook.Sheets("source").Columns(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone 


     Application.DisplayAlerts = True 
     Application.CutCopyMode = False 

    End With 
     srcBook.Close False 

    End Sub 

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

Jim