Question

首先，这是我的工作簿链接，上传到OneDrive：

https://1drv.ms/x/s!AsQuasddi71ugRSDelemaNIBKazB

过去几周我一直在尝试开发代码，在列中搜索标题，以确定我想要复制的范围。

我在Excel中获得的结果：要查找“否”的列字母：

=SUBSTITUTE(ADDRESS(1;MATCH("No.";1:1;0);4);"1";"")

结果：B

要查找“否”的列标题和第一行：

=ADDRESS(1;MATCH("No.";1:1;0);4)

结果：B1

查找“预付款额不含增值税”的栏目信函：

=SUBSTITUTE(ADDRESS(1;MATCH("Prepayment Amount excl VAT";1:1;0);4);"1";"")

结果：L

要查找“预付款额外增值税”的列标题和第一行：

=ADDRESS(1;MATCH("Prepayment Amount excl VAT";1:1;0);4)

结果：L1

在excel文件中，我有两个模块... Module1正在根据列工作，这意味着它将始终复制工作表1中的列B和L，以及工作表2中的列A和B ...

在Module2中，我一直在尝试创建一个宏，它应该在列的Header名称上导航，并返回单元格B1和列B以将列声明为：

sht.Range("B1:B" & LastRow).Copy

否则我想将一个替换，地址，匹配公式分配给一个变量，我想用......替换“B1”和“B”。

目前我收到很多错误......

我是否能够使用我的替换，地址，匹配公式的结果来替换sht.Range("B1:B" & LastRow).Copy中的“B1”和“B”？

如果您有任何想法，请告诉我如何根据我的意愿纠正宏：）

我的宏如下所示：

Sub CopyPasteDataLookingForHeader()
Dim sht, sht2, sht3 As Worksheet
Dim i, LastRow, LastRow2 As Long
Dim Number, NumberOne, Prepay, PrepayOne As Variant
Set sht = Sheets("Sales List")
Set sht2 = Sheets("Match Sales List and Pivot")
Set sht3 = Sheets("Pivot of Prepayment account")
Number = Application.WorksheetFunction.Substitute(sht.Range("1:1").Address(1, Application.WorksheetFunction.Match("No.", sht.Range("1:1"), 0), 4), 1, "")
NumberOne = sht.Range("1:1").Address(1, Application.WorksheetFunction.Match("No.", sht.Range("1:1"), 0), 4)
Prepay = Application.WorksheetFunction.Substitute(sht.Range("1:1").Address(1, Application.WorksheetFunction.Match("Prepayment Amount excl VAT", sht.Range("1:1"), 0), 4), "1", "")
PrepayOne = sht.Range("1:1").Address(1, Application.WorksheetFunction.Match("Prepayment Amount excl VAT", sht.Range("1:1"), 0), 4)
LastRow = sht.Cells(sht.Rows.Count, Number).End(xlUp).Row
LastRow2 = sht3.Cells(sht3.Rows.Count, "B").End(xlUp).Row

Dim rng1, rng2 As Range
rng1 = "NumberOne:Number"
rng2 = "PrepayOne:Prepay"

sht.Range(rng1 & LastRow).Copy
sht2.Activate
Range("D1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
sht.Range(rng2 & LastRow).Copy
sht2.Activate
Range("E1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
sht3.Range("A1:A" & LastRow2).Copy
sht2.Activate
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
sht3.Range("B1:B" & LastRow2).Copy
sht2.Activate
Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
Columns("A:E").ColumnWidth = 25
End Sub

Answer 1

引用变量时，请勿将它们放在引号中。现在，代码有rng1 = "NumberOne:Number"，Excel按字面解释。您将要连接文本片段以形成范围。尝试：

Dim FindNo, Number, NumberOne, FindPrepay, Prepay, PrepayOne As String

FindNo = Sht.Range("1:1").Find("No.").Address(False, False, xlA1)
Number = Application.WorksheetFunction.Substitute(FindNo, 1, "")
NumberOne = FindNo

FindPrepay = Sht.Range("1:1").Find("Prepayment Amount excl VAT").Address(False, False, xlA1)
Prepay = Application.WorksheetFunction.Substitute(FindPrepay, 1, "")
PrepayOne = FindPrepay

rng1 = NumberOne & ":" & Number & LastRow
rng2 = PrepayOne & ":" & Prepay & LastRow

这也使用VBA Range.Find和Address方法，而不是调用工作表函数。

Answer 2

我不确定我是否完全理解您的问题，但我最近开发了一个数据验证下拉框，可以回答您的问题。

我有两张纸。 Sheet1.Column＆＃34; A＆＃34;员工姓名。范围（＆＃34; B1＆＃34;）有一个下拉框，其中包含第二张表中的标题名称，称为＆＃34; DataBase＆＃34;

Sheet（＆＃34; DataBase＆＃34;）在Column＆＃34; A＆＃34;中也具有相同的员工姓名。但它也有＃34;电话号码＆＃34;在栏目＆＃34; B＆＃34;，＆＃34;地址＆＃34;在＆＃34; C＆＃34;，＆＃34;下一个Kin＆＃34;在列＆＃34; D＆＃34;等等。 Sheet的第一行（＆＃34; DataBase＆＃34;）具有与上面引号中的名称对应的标题名称。

在sheet1上，在＆＃34; B1＆＃34;中创建一个验证列表框。通过选择＆＃34; B1＆＃34;并单击“数据”菜单 - ＆gt;验证。选择＆＃34;列表＆＃34;在窗口中选择第二个工作表的标题， - 工作表（＆＃34;数据库＆＃34;），作为列表框的列表。然后简单地将以下代码放在Sheet1的模块中:(当然，您必须更改标题名称和列以适合您自己的项目，但这将使您了解如何获取不同的范围，复制它们到其他目的地。）

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
Dim myRng As Range

Application.EnableEvents = True
Application.ScreenUpdating = False
Sheet2.Activate

    LR = lastRowCol(Sheet2, "B")

    If Target.Row = 1 And Target.Column = 2 Then

        Select Case Target.Value

            Case "Date of Birth"
                Set myRng = Sheet2.Range("B2:B" & LR)

            Case "Phone Number"
                Set myRng = Sheet2.Range("C2:C" & LR)

            Case "Seniority Date"
                Set myRng = ActiveSheet.Range("D2:D" & LR)

            Case "Next of Kin"
                Set myRng = Sheet2.Range("E2:E" & LR)

        End Select

    End If
    Application.EnableEvents = False
    Sheet1.Range("B2:B5000").ClearContents
    myRng.Copy Destination:=Worksheets("Sheet1").Range("B2")
    Sheet1.Activate
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub




Function lastRowCol(sht1 As Worksheet, col As String) As Long
lastRowCol = sht1.Cells(sht1.Rows.Count, col).End(xlUp).Row
End Function

WorksheetFunction确定列并将结果用作范围

2 个答案: