Excel 基于单元格值复制列

我想制作一个VBA脚本，它可以基于单元格值将列复制到另一个工作表

因此，“SheetA”在单元格A1中的值为“3-2014”（月份值可以更改）

工作表“SheetB”包含如下所示的数据库：

2-2014 3-2014 4-2014

值a值b值c

值d值e值f

所以现在我想把包含“3-2014”的专栏复制到“SheetC”页

结果将出现在“SheetC，第1列”

2014年3月3日

b值

值e

我看了又试，但找不到答案，真希望有人能帮我

祝2015年和thnx一切顺利

亲切问候,

吉姆

你可以用赫卢库普

在“表C第1列”中，公式为

=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)

是吗

我知道这不符合专栏，但我怀疑这就是你想要的

或者这是VBA

 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

---

必须使用VBA完成吗

我会在SheetC中使用A1：

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

把它拖下来

---

希望它能起作用

谢谢你的建议。我一直在努力解决我的问题，并提出了以下解决方案

  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的了解不是很好

吉姆