Question

我正在编写一个宏，它利用userform定义一个值，我稍后需要在程序中引用它（Val1）。宏需要进入特定的电子表格，查看几个标题，如果值匹配，则需要复制该列中的所有数据并将其粘贴到同一工作簿中的不同电子表格中。

目前，我得到了一个

运行时错误1004＆＃39;选择范围类的方法失败＆＃39;

在cell.End(xlDown).Select

public NewSheetName as string, val1 as string
    Dim f As Range
Set f = ThisWorkbook.Sheets(1).Range("B1:L1")

For Each cell In f
    If cell = val1 Then
    cell.End(xlDown).Select
    selection.Copy Destination:=ThisWorkbook.Sheets(NewSheetName).Range("B1")
'NewSheetName is defined elsewhere
    End If
Next

Answer 1

我相信这就是你要找的东西我首先找到match，这将是您要搜索的列号。

然后我复制列并粘贴值不需要循环。

on error resume next ' if nothing is found it creates an error
match = Split(Cells(1, Cells(1, 1).EntireRow.Find(what:=val1, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, searchdirection:=xlNext, MatchCase:=True).Column).Address(True, False), "$")(0)
on error goto 0
if match = "" or match > "L" then
    msgbox "nothing found in range"
else
    Range(match & ":" & match).Copy ' copies column "E:E" for example
    ThisWorkbook.Sheets(NewSheetName).Range("B1").Select ' selects output cell
    ActiveSheet.Paste ' paste
end if

Answer 2

使用2个工作表构建新的Excel工作簿;
在第一个问题上，在B1:L1范围内写下＆＃34;＆＃34; 3-4次;
在范围B2:L10;

运行：

Option Explicit

Public Sub TestMe()

    Dim val1 As String: val1 = "something"
    Dim cell As Range
    Dim f As Range

    Set f = Worksheets(1).Range("B1:L1")

    For Each cell In f
        If cell = val1 Then
            cell.End(xlDown).Copy Destination:=Worksheets(2).Range(cell.Address)
        End If
    Next

End Sub

它遍历第一个工作表的Range(B1:L1)，如果在那里找到单词something，它会将范围复制到第二个工作表。

Answer 3

这是一种避免循环的方法：

Sub foo(ByVal sVal1 As String, ByVal sSheetName As String)
    Dim c As Range

    Set c = ThisWorkbook.Sheets(1).Range("B1:L1").Find(what:=sVal1)
    If Not c Is Nothing Then
        Range(c, c.End(xlDown)).Copy Destination:=ThisWorkbook.Sheets(sSheetName).Range("B1")
    End If
End Sub

在VBA中匹配两个字符串，将其他单元格值传输到其他位置

3 个答案: