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

Question

首先，这里有一个 link 到我的工作簿，已上传到 OneDrive：

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

这几周我一直在尝试开发代码，在一个列中搜索Header，确定我要复制的范围。

我在Excel中得到的结果：要查找 "No." 的列字母：

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

结果：B

查找 header 列和 "No." 的第一行：

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

结果：B1

要查找 "Prepayment Amount excl VAT" 的列字母：

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

结果：L

查找 header 列和 "Prepayment Amount excl VAT" 的第一行：

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

结果：L1

在 excel 文件中，我有两个模块...模块 1 基于列工作，这意味着它将始终复制 Sheet 1 中的 B 列和 L 列，以及 A 列和B 在 sheet 2...

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

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

否则我想将 Substitute、Address、Match 公式分配给一个变量，我想用...

替换 "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

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

我有两个 sheet。 Sheet1.Column "A" 是员工姓名。 Range("B1") 有一个下拉框，其中包含来自第二个 sheet 的 header 个名称，称为 "DataBase"

Sheet("DataBase") 在列 "A" 中也有相同的员工姓名。但它在 "B" 列中也有 "Phone Number"，在 [=27= 列中有 "Address"，在 "D" 列中有 "Next of Kin"，等等。 Sheet("DataBase") 的第一行有 header 个名称对应于上面引号中的名称。

在 sheet1 上通过 selecting "B1" 并单击数据菜单 -> 验证在 "B1" 中创建验证 list-box。在第2个sheet的window和select的header中选择"List"，-Sheet("DataBase")，如列表框的列表。然后只需将以下代码放入 Sheet1 的模块中：（当然，您必须更改 header 名称和列以适合您自己的项目，但这会让您了解如何获得不同的范围，将它们复制到其他目的地。）

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

Answer 2

引用变量时，不要将它们放在引号中。现在，代码有 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 方法，而不是调用工作表函数。

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

WorksheetFunction to determine column and use result as range

excel

vba

worksheet-function