首页 > 解决方案 > VBA 记录列 Z 之后的列名

问题描述

我有一些代码多年来一直运行良好,问题是现在我的数据已经超过 z 列并且代码不再工作,一旦它超过 z 列,范围字符串值是 [29 而不是 AA29 ,AB29 等。任何人都可以给我对如何完成这项工作的指导至少需要转到 AW 栏。其他人告诉我,我犯了一个根本错误,因为我应该使用列号而不是名称。我不是专家,并且通过蚕食我在这里和其他地方找到的代码来设法使它工作。我的代码在下面,希望它是可以理解的。

Sub Copy_picked_X1s_to_final_56()
    Dim SelectedName() As String              'this array holds the "SelectedName" for a specific date
    Dim AllNames() As Variant                  'this array holds all the names in the "Final Assignments"
    Dim NameCount1 As Long, NameCount2 As Long 'namecount 1 holds a count of the "SelectedName", namecount 2 holds a count of "AllNames" in the "Final Assignments"
    Dim Services() As Variant                  'this array holds a list of all the "Services"
    Dim Columncounter As Long                  'this array holds a count of all the columns that have "Services"
    Dim NameCell As String                     'this string holds the location of the cell in "Final Assignments" where the "SelectedName" appears
    Dim location As String
    Dim Name1 As String
    Dim Name2 As String
    Dim NameFound As Long
    Dim FillArray As Long                      'used to loop through the various arrays
    Dim RangeString As String
    Dim ServiceCount As Long

    '***********************************************************************************************'
    ' Fill the services array with the full list of services and loop through the services
    '***********************************************************************************************'

    Sheets("Final Assignments").Select 'select "Final Assignments" worksheet
    ServiceCount = Range("B3", Range("B3").End(xlToRight)).Cells.Count - 1 'set range of "Services" to count

    ReDim Services(0 To ServiceCount) 'Redimension the "Services" array

    For Columncounter = 0 To ServiceCount
        'Services(Columncounter) = Range("B3").Offset(0, Columncounter).Value 'collect the values
    Next Columncounter

    '***********************************************************************************************'
    ' Loop through all the services
    '***********************************************************************************************'

    For Columncounter = 0 To ServiceCount

        Sheets("Sorted X1").Select 'select "Sorted X1" worksheet
        RangeString = Chr(65 + Columncounter) & "29" 'set the range based on the columncounter

        NameCount1 = Range(RangeString, Range(RangeString).End(xlDown)).Cells.Count - 1 'count the number of names for the first date

        ReDim SelectedName(0 To NameCount1) 'Redimension the "SelectedName" array
        If SelectedName(0) = "" And SelectedName(1) = "" And NameCount1 = 1 Then
            For FillArray = 0 To NameCount1 'gather the names

                SelectedName(FillArray) = Range(RangeString).Offset(FillArray).Value
            Next FillArray
        End If

        '***********************************************************************************************'
        'Now select the first name in the final assignments list
        '***********************************************************************************************'

        Sheets("Final Assignments").Select 'select "Final Assignments" worksheet
        NameCount2 = Range("A4", Range("A4").End(xlDown)).Count - 1 'count the number of "AllNames" in the "Final Assignments"
        Range("A3").Select
        If NameCount1 < 4 Then
            For NameFound = 0 To NameCount2
                ActiveCell.Offset(1, 0).Select

                For FillArray = 0 To NameCount1

                    If SelectedName(FillArray) = ActiveCell.Value Then
                        ActiveCell.Offset(0, Columncounter + 1).Value = "X1"   'Services(Columncounter)
                    End If

                Next FillArray

            Next NameFound
        End If
    Next Columncounter 'increment along the row

End Sub

标签: excelvba

解决方案


问题出在:

RangeString = Chr(65 + Columncounter) & "29" 'set the range based on the columncounter

这部分代码确实可以工作到Z. 这不是一个好的选择。使用该Offset属性,以获取正确的地址。例如,下面的代码给出了第一行第 5000 列的地址:

Sub TestMe()

    Dim myRange As Range
    Dim addCols As Long: addCols = 5000

    Set myRange = Worksheets(1).Range("A1")
    Debug.Print myRange.Offset(0, addCols).Address

End Sub

或者甚至将新范围作为范围获取,而不将其地址分配给变量:

Sub TestMe()

    Dim myRange As Range, newRange as Range
    Dim addCols As Long: addCols = 5000

    Set myRange = Worksheets(1).Range("A1")
    Set newRange = myRange.Offset(0, addCols)
    Debug.Print newRange.Address

End Sub

推荐阅读