Question

我有以下代码遍历C列中的值。当它找到单词“ Search”时，该代码为D到F列创建一个名为“ Search”的命名范围。

document.addEventListener("DOMContentLoaded", function(event) {
    function openNav() {
        document.getElementById("OffcanvasNav").style.left = "0"
        document.getElementById("openNav").style.display = "none"
        document.getElementById("closeNav").style.display = "initial"
    }

    document.getElementById("openNav").onclick = openNav

    function closeNav() {
        document.getElementById("OffcanvasNav").style.left = "100%"
        document.getElementById("closeNav").style.display = "none"
        document.getElementById("openNav").style.display = "initial"
    }

    document.getElementById("closeNav").onclick = closeNav
});

document.getElementById("openNav").onclick = openNav should open my offcanvas navbar.

document.getElementById("closeNav").onclick = closeNav should clode my offcanvas navbar.

但是，尽管它在名称管理器上看起来不错，但是当我使用VBA将范围转换为单词表时，似乎将所有值粘贴到C列中“搜索”一词的位置。请注意，CI列中有各种单元格值，例如“ Reporting”，“ Search”，“ Search and Filter”，“ Search and Analyse”等。因此，粘贴到word中的范围似乎包含来自“搜索和..”单元格也是如此。

这是我用来导出到单词中书签位置的代码...

Dim featuresRng As Range
Dim rng As Range
Dim sht As Worksheet
Dim counter As Long
Dim cell As Range

Set sht = ThisWorkbook.Worksheets("Features")
Set featuresRng = sht.Range(sht.Range("C1"), sht.Range("C" & sht.Rows.Count).End(xlUp)) 'dynamically set the range of features
counter = 0 'this counter will help us avoid Union(Nothing, some range), which would give an error

For Each cell In featuresRng 'loop through the range of features
    If cell.Value = "Query Builder" Then
        counter = counter + 1
        If counter = 1 Then
            Set rng = sht.Range(cell.Offset(0, 1), cell.Offset(0, 3))
        Else
            Set rng = Union(rng, sht.Range(cell.Offset(0, 1), cell.Offset(0, 3))) 'build the range
        End If
    End If
Next cell
Debug.Print rng.Address
ThisWorkbook.Names.Add "QuBuild", rng

任何人的帮助，一如既往，非常感谢！

Answer 1

代码中观察到的问题

要使用单词打开新文档，请尝试类似“设置myDoc = Wordapp.Documents.Add”
不知道什么是DoesNameRangeExist，如果是代码中未生成的子例程
有问题的NamedRange的名称为“ QuBuild”，但您已使用名称“ Search”

尝试进行以下修改以使其正常工作（经我测试可以正常工作）。

添加对Microsoft Word XX对象库的引用

在声明部分

Dim Nm As Name
Dim Wordapp As Word.Application
Dim myDoc  As Word.Document

最后一节

Set myDoc = Wordapp.Documents.Add

    For Each Nm In ThisWorkbook.Names
        If Nm.Name = "QuBuild" Then
        Nm.RefersToRange.Copy
        Debug.Print Nm.RefersToRange.Address
        myDoc.Bookmarks.Add "Search", myDoc.Range
        myDoc.Range.PasteExcelTable False, False, False
        Exit For
        End If
    Next Nm

编辑：但是，在试用中发现，PasteExcelTable方法正在复制并集范围非相邻行之间的所有相邻行。可以参考SO Post，但是帖子中的答案不能解决问题，最终请采取以下冗长的方法进行正确的操作。 邀请并渴望学习更多简单解决方案，可以直接将Excel的粘贴Union范围复制到专家的Word中。

代码：

Set myDoc = Wordapp.Documents.Add
    Dim RngtoCopy As Range
    Dim xArea As Range, Rw As Range, col As Long, Tbl As Table
    Dim TotalRow As Long

    'If both the section of code are in the same procedure
    'then it is not be necessary to use next loop to find NamedRange
    'And can be directly refer as Rng.Areas  instead of RngtoCopy.Areas
    For Each Nm In ThisWorkbook.Names
        If Nm.Name = "QuBuild" Then
        Set RngtoCopy = Nm.RefersToRange
        Exit For
        End If
    Next Nm

    Set Tbl = myDoc.Tables.Add(myDoc.Range, 1, 3)
    TotalRow = 0
        For Each xArea In RngtoCopy.Areas
            For Each Rw In xArea.Rows
            TotalRow = TotalRow + 1
            If TotalRow > Tbl.Rows.Count Then Tbl.Rows.Add
            col = 0
                For Each cell In Rw.Columns
                col = col + 1
                Tbl.cell(TotalRow, col).Range.Text = cell.Value
                Next
            Next
        Next

根据单元格中的精确字符串值创建命名范围

1 个答案: