Question

我在尝试更改excel宏以执行我想要的操作时遇到了很多麻烦。我有一个工作表（称为用户工作表），其第70列（BR）根据另一个工作簿中的列自动填充。我需要更改我的宏，以便它将根据它的标题名称而不是它的列索引来填充此列。它用于匹配工作表之间的行的主键列还必须基于它的列名而不是它的列索引。原因是因为使用此工作表的人可能会添加和移动列，因此基于列索引执行此操作将不起作用。

现在，主键列位于B列中。标题行位于第2行，而不是第1行.srcReturnCol是另一个工作表中的列，其中包含用户工作表列填充的数据。 srcIdCol是另一个工作表中的主键列。 r，c，user_ran和id也都设置为范围。

我试图模仿我在参考工作表中查找返回和主键列的名称，但我尝试过的任何工作都没有。对此我的任何帮助都非常感谢！

..............


    LR = user_sheet.Cells(Rows.Count, "B").End(xlUp).Row
    Set user_ran = user_sheet.Range("BR3:BR" & LR)

    For Each c In user_ran.Cells

        id = c.EntireRow.Cells(3).Value

        If Len(id) > 0 Then

            r = Application.Match(id, srcIdCol, 0)

            If Not IsError(r) Then
                c.Value = Application.Index(srcReturnCol, r, 1)
            Else
                c.Value = "ITEM NOT FOUND"
            End If
        End If
    Next c

End Sub

Set g = user_sheet.Rows(2).Find(what:="Primary Key", _
                                lookat:=xlWhole, LookIn:=xlValues)

    If Not g Is Nothing Then
        Set userReturnCol = g.EntireColumn
    End If

    Set g = Nothing
    Set g = user_sheet.Rows(2).Find(what:="Return Value", _
                                lookat:=xlWhole, LookIn:=xlValues)

    If Not g Is Nothing Then
        Set userIdcol = g.EntireColumn
    End If

    LR = user_sheet.Cells(Rows.Count, userIdCol).End(xlUp).Row
    Set user_ran = user_sheet.Range(userReturnCol)

    For Each c In user_ran.Cells

        id = c.EntireRow.Cells(3).Value

        If Len(id) > 0 Then

            r = Application.Match(id, srcIdCol, 0)

            If Not IsError(r) Then
                c.Value = Application.Index(srcReturnCol, r, 1)
            Else
                c.Value = "PROJECT NOT FOUND"
            End If
        End If
    Next c

End Sub

Answer 1

您可以尝试使用这个有点笨重的函数来获取匹配字符串的列

详细信息：

i = Get_Col(worksheet.name, sStringToFind) ' by default will return the column

您可以将第三个参数设置为true，或者设置为1来检索该行。

默认情况下，它使用近似匹配来修剪搜索字符串和比较字符串中的所有前导和尾随空格，并且在比较时使它们都为大写。

如果您想要完全匹配，请将第5个参数设置为true。

i = Get_Col(worksheet.name, sStringToFind, False, True, True)

Get_Col参数

工作表名称AS字符串
要在工作表中查找字符串AS字符串
bGetRow AS boolean - 如果要返回行号而不是 - 默认为false
bGetCol AS boolean - 默认为true
bExact AS boolean - 默认为false - 如果要拉出完全匹配，则为true。

Function Get_Col(sWS As String, sFind As String, Optional bGetRow As Boolean = False, Optional bGetCol As Boolean = True, Optional bExact As Boolean = False) As Integer
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim r As Long, c As Integer
    Dim t As String

    Set wb = ThisWorkbook
    Set ws = wb.Sheets(sWS)

    On Error GoTo Finish
    With ws
        Do
            r = r + 1
            For c = 1 To 16384
                t = .Cells(r, c)
                If bExact Then
                    If t = sFind Then
                        Exit Do
                    End If
                Else
                    If UCase(Trim(t)) = UCase(Trim(sFind)) Then
                        Exit Do
                    End If
                End If
            Next c
        Loop
    End With

Finish:
    If Err.Number = 0 Then
        If bGetRow Then
            Get_Col = r
        ElseIf bGetCol Then
            Get_Col = c
        End If
    End If
End Function

像这样使用：

Sub Test()
    Dim sWS As String
    Dim sPK As String, sOther As String
    Dim iColPK As Integer, iColOther As Integer
    Dim iRowPK As Long, iRowOther As Long

    sWS = "Sheet3"
    sPK = "Primarily the Key"
    sOther = "The Other Column"

    iColPK = Get_Col(sWS, sPK)
    iRowPK = Get_Col(sWS, sPK, True)

    iColOther = Get_Col(sWS, sOther)
    iRowOther = Get_Col(sWS, sOther, True)

    Debug.Print "PK: Cell(" & iRowPK & ", " & iColPK & ")"
    Debug.Print "Other: Cell(" & iRowOther & ", " & iColOther & ")"
    ' PK: Cell(10, 8)
    ' Other: Cell(18, 12)
End Sub

设置一个如何使用上面第二段代码实现的示例：

Sub Help2()
    'Set g = user_sheet.Rows(2).Find(what:="Primary Key", _
    '                           lookat:=xlWhole, LookIn:=xlValues)
    g = Get_Col(user_sheet.Name, "Primary Key") '**************** INSERT THIS CODE

    If Not g Is Nothing Then
        Set userReturnCol = g.EntireColumn
    End If

    Set g = Nothing
    'Set g = user_sheet.Rows(2).Find(what:="Return Value", _
    '                            lookat:=xlWhole, LookIn:=xlValues)
    g = Get_Col(user_sheet.Name, "Return Value") '**************** INSERT THIS CODE

    If Not g Is Nothing Then
        Set userIdCol = g.EntireColumn
    End If

    LR = user_sheet.Cells(Rows.Count, userIdCol).End(xlUp).Row
    Set user_ran = user_sheet.Range(userReturnCol)

    For Each c In user_ran.Cells

        ID = c.EntireRow.Cells(3).Value
        If Len(ID) > 0 Then
            r = Application.Match(ID, srcIdCol, 0)

            If Not IsError(r) Then
                c.Value = Application.Index(srcReturnCol, r, 1)
            Else
                c.Value = "PROJECT NOT FOUND"
            End If
        End If
    Next c
End Sub

根据列标题名称自动填充列

1 个答案:

Get_Col参数