Question

我想创建一个VBA脚本，可以根据单元格值将列复制到另一个工作表。

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

Sheet“SheetB”包含数据库，如下所示：

2-2014 3-2014 4-2014

将值b值c

值d值e值f

所以现在我想将包含“3-2014”的列复制到工作表“SheetC”。

结果将在“SheetC，第1列”

中

3-2014

价值b

值e

我看了又试过但找不到答案，真的希望有人可以帮助我。

2015年和thnx的祝福！

亲切的问候，

吉姆

Answer 1

你可以使用HLOOKUP。

In＆＃34; SheetC，第1栏和第34页;论坛将是

=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

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

它并不漂亮，而且我确信通过使用Range可以使这更好，但我对VBA的了解并不是那么好。

吉姆

根据单元格值复制列

3 个答案: