Question

我有一个excel工作簿，可以导入来自文本文件的未知数量的数据（用户将根据需要导入尽可能多的文本文件）。每次将文本文件导入工作簿时，我都附加一个标识符（1,2,3等）。在“信息表”中，我有一个表单控件组合框，用户通过从下拉列表中选择标识符值来选择“初始数据集”，即（1,2,3等）。我想要发生的是当用户选择一个值来指定初始数据集时，该数据集将在“数据导入表”（也称为导入所有数据的工作表）上以灰色突出显示。我认为我的代码很接近，但它不起作用。

这是我的Combobox代码：

Private Sub ComboBox1_Change()
Call Find_Initial_Data_Set
End Sub

这是我的代码，用于根据我的Combobox所在的单元格E12中的值突出显示“数据导入表”中的数据：

Sub Find_Initial_Data_Set()

    Dim ws As Worksheet
    Dim aCell As Range
    Dim aCell1, aCell2, aCell3 As Range
    Dim NewRange As Range
    Dim A As String
    Dim LastRow As Integer

    Worksheets("Information Sheet").Activate

    If Range("E12").Value <> "" Then
        Set ws = Worksheets("Data Importation Sheet")
        A = Worksheets("Information Sheet").Range("E12").Value

        Worksheets("Data Importation Sheet").Activate

        With ws
            Set aCell = .Rows(1).Find(What:=A, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        End With

        LastRow = Worksheets("Data Importation Sheet").Cells(Rows.Count, "A").End(xlUp).Offset(-1).Row

        With ws
            Set aCell1 = aCell.Offset(0, -1)
            Set aCell2 = aCell.Offset(LastRow, 5)

            Debug.Print aCell1.FormulaR1C1
            Debug.Print aCell2.FormulaR1C1

            Set NewRange = .Range(aCell1.Address & ":" & aCell2.Address)

            Debug.Print NewRange.Address
        End With

        NewRange.Interior.ColorIndex = 15
    Else
    End If
End Sub

以下是我的excel书的一些视觉效果：输入数据的数据导入表（您无法在此图片中看到标识符，但在数据下方我有一个单元格，其中标识符旁边有相应的输入值）：

信息表，用户根据标识符选择初始数据集：

这就是我希望数据导入表在用户为初始数据集选择1（例如）之后的样子：

非常感谢任何建议！

Answer 1

您需要将LastRow更改为以下内容，因为您只需要行号：

LastRow = Worksheets("Data Importation Sheet").Cells(Rows.Count, "A").End(xlUp).Row - 1

Answer 2

代码就是这样。

表格代码

Private Sub ComboBox1_Change()
Call Find_Initial_Data_Set(ComboBox1.Text)
End Sub

模块代码

Sub Find_Initial_Data_Set(A As String)

    Dim Ws As Worksheet
    Dim aCell As Range, NewRange As Range
    Dim LastRow As Integer
    Set Ws = Worksheets("Data Importation Sheet")
    With Ws
        If A <> "" Then
            Set aCell = .Rows(1).Find(what:=A, after:=.Range("a1"), LookIn:=xlValues, lookat:=xlPart)
            If aCell Is Nothing Then
            Else
                Set aCell = aCell.Offset(, -1)
                LastRow = .Range("a" & Rows.Count).End(xlUp).Row
                Set NewRange = aCell.Resize(LastRow, 7)
                NewRange.Interior.ColorIndex = 15
            End If
        End If
    End With
End Sub

Answer 3

我稍微重写了你的代码

请使用F8键单步执行代码

检查是否选择了正确的范围＆＃34;＆＃34; at＆＃34; debug＆＃34;线

请使用调查结果更新您的帖子

我怀疑工作表部分填充后会引用错误的单元格

另外，请不要使用:( ......这意味着，任何读这篇文章的人）

    With ws
        Set aCell = .Rows(1).Find(What:=A, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    End With

使用它：

    Set aCell = ws.Rows(1).Find(What:=A, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

它更短，更易读

使用＆＃34;使用＆＃34;惯例，只有它真的简化了代码

请参阅代码的末尾以获取可能对您有帮助的信息

Sub Find_Initial_Data_Set()

    Dim infoSht As Worksheet
    Dim dataImpSht As Worksheet

    Dim aCell As Range

'   Dim aCell1, aCell2 As Range    ' do not use ... aCell1 is declared as variant. not as range

    Dim aCell1 As Range, aCell2 As Range, aCell3 As Range
    Dim NewRange As Range
    Dim A As String
    Dim LastRow As Integer

    Set dataImpSht = Worksheets("Data Importation Sheet")
    Set infoSht = Worksheets("Information Sheet")

    A = infoSht.Range("E12").Value
    If A <> "" Then

        Set aCell = dataImpSht.Rows(1).Find(What:=A, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

        dataImpSht.Activate                 ' debug   .Select command fails if sheet is not visible
        aCell.Select                        ' debug   (this should highlight "aCell")

        dataImpSht.Cells(dataImpSht.Rows.Count, "A").Select                        ' debug
        dataImpSht.Cells(dataImpSht.Rows.Count, "A").End(xlUp).Select              ' debug
        dataImpSht.Cells(dataImpSht.Rows.Count, "A").End(xlUp).Offset(-1).Select   ' debug
        dataImpSht.Cells(dataImpSht.Rows.Count, "A").End(xlUp).Offset(1).Select    ' debug

        LastRow = dataImpSht.Cells(dataImpSht.Rows.Count, "A").End(xlUp).Offset(-1).Row


        aCell.Select                         ' debug
        aCell.Offset(0, -1).Select           ' debug
        aCell.Offset(LastRow, 5).Select      ' debug

        Set aCell1 = aCell.Offset(0, -1)
        Set aCell2 = aCell.Offset(LastRow, 5)

        aCell1.Select                      ' debug
        aCell2.Select                      ' debug

        Debug.Print aCell1.FormulaR1C1
        Debug.Print aCell2.FormulaR1C1

        Set NewRange = dataImpSht.Range(aCell1.Address & ":" & aCell2.Address)

        NewRange.Select                      ' debug

        Debug.Print NewRange.Address

        NewRange.Interior.ColorIndex = 15

    End If


'---------------------------------------------------------------------------
        ' check this out ... it may be what you need to use
        Dim aaa As Range

        Set aaa = dataImpSht.Cells(dataImpSht.Rows.Count, "A").End(xlUp).Offset(1)
        aaa.Select
        aaa.Range("a1").Select   ' aaa can be thought off as the new top left corner
        aaa.Range("b2").Select   ' you can refer to cells in relation to aaa

        Set aaa = aaa.Offset(4)  ' and move position of aaa for each iteration
        aaa.Range("a1").Select
        aaa.Range("b2").Select
'---------------------------------------------------------------------------

End Sub

用户从动态表单控件组合框

3 个答案: