For循环以唯一命名范围内的每个非空单元格答案

【问题标题】：For loop to uniquely name each non empty cell in a rangeFor循环以唯一命名范围内的每个非空单元格
【发布时间】：2023-02-04 09:46:38
【问题描述】：

下面的代码命名区域中的最后一个单元格，而不是区域中的每个单元格。

我正在尝试运行此循环，以便从单元格 A1 开始，将所有非空单元格命名为“Guidance1”、“Guidance2”，依此类推。

Sub GiveAllCellsNames()

    Dim wb As Workbook
    Set wb = ActiveWorkbook

    Dim R As Range
    Dim NameX As String

    Static I As Long
    I = I + 1
 
    NameX = "Guidance" & I

    For Each R In Range("A1:A390").Cells
        If R.Value <> "" Then
            With R
                wb.Names.Add NameX, RefersTo:=R
            End With
        End If
    Next R

End Sub

我在“R”范围变量上没有使用“with 语句”的情况下尝试了这个循环，得到了相同的结果。

【问题讨论】：

您没有在循环内更新 NameX - 您不能为所有单元格指定相同的名称。
@蒂姆威廉姆斯。关于如何在循环中更新 NameX 的任何建议？是否只是在循环内声明变量的问题？
ActiveWorkbook 是包含这段代码的工作簿吗？这些命名单元格所在的工作表的名称是什么？

标签： excel vba for-loop named-ranges

【解决方案1】：

可以使用 Range 对象的名称属性添加命名范围。

改变

 wb.Names.Add NameX, RefersTo:=R

到

 R.Name = NameX

I 需要递增并且名称应该在循环内更新。

Sub GiveAllCellsNames()

    Dim wb As Workbook

    Set wb = ActiveWorkbook

    Dim R As Range

    Dim NameX As String

    Static I As Long

    For Each R In Range("A1:A390").Cells

        If R.Value <> "" Then
        
            I = I + 1
            NameX = "Guidance" & I
            
            With R

                wb.Names.Add NameX, RefersTo:=R

            End With

        End If

    Next R

End Sub

【讨论】：

不幸的是，这产生了相同的结果。不过，我很欣赏这种尝试。
@KevinPerez 对此感到抱歉。我更新了我的答案。您确定要将I 设为静态变量吗？
这非常有效。是的，目的是静态递增 #，以便每个名称对于范围内的每个非空白单元格都是唯一的。感谢您的帮助，因为我现在知道在循环中进行这样的更改以供将来参考。谢谢你！

【解决方案2】：

命名非空白单元格

Sub NameAllCells()

    Const BeginsWithString As String = "Guidance"

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
    Dim rg As Range: Set rg = ws.Range("A1:A390")
    Dim Data() As Variant: Data = rg.Value
    
    DeleteNamesBeginsWith wb, BeginsWithString
    
    Dim r As Long
    Dim n As Long
    
    For r = 1 To UBound(Data, 1)
        If Len(CStr(Data(r, 1))) > 0 Then
            n = n + 1
            wb.Names.Add BeginsWithString & n, rg.Cells(r)
        End If
    Next r

End Sub

Sub DeleteNamesBeginsWith( _
        ByVal wb As Workbook, _
        ByVal BeginsWithString As String)
    
    Dim nmLen As Long: nmLen = Len(BeginsWithString)
    
    Dim nm As Name
    
    For Each nm In wb.Names
        If InStr(1, nm.Name, BeginsWithString, vbTextCompare) = 1 Then nm.Delete
    Next nm
    
End Sub

【讨论】：