Question

感谢您花时间阅读本文。我有一个主联系人工作簿，其中包含需要跟进电话的人员列表。在本工作簿的第一列中列出了被分配后续呼叫的人的姓名缩写（例如：CWS）。我想要的是一个公式，它将扫描第一列中所有单元格的一组首字母，然后将数据从E到J列复制到专门分配给该案例管理器的新工作簿。下面的代码只是一个骨架，但它足以做一个小的测试运行。我没有在10年内触及过VBA，所以我确信它远非完美

Sub MoveContactInfo()
Dim xrow As Long
xrow = 4
Sheets("Master Data Set").Select
Dim lastrow As Long
lastrow = Cells(Rows.Count, 1).End(x1Up).Row
Dim rng As Range

Do Until xrow = lastrow + 1
    ActiveSheet.Cells(xrow, 1).Select
    If ActiveCell.Text = "CWS" Then
    rng = Range(Cells(xrow, 5), Cells(xrow, 10))
    rng.Copy
    Workbooks.Open Filename:="D:\My Documents\Excel Spreadsheets\TEST.xls"
    Worksheets("CWS").Select
    Cells(4, 1).PasteSpecial
    End If

xrow = xrow + 1
Loop

End Sub

非常感谢你的帮助。如果还有其他我可以澄清的内容，请告诉我。现在，我只是想粘贴到我创建的测试工作簿中，其中填写了每个Case Manager命名的工作表。

Answer 1

如果您只搜索一次单个值，我会避开public void watchPath(Path watchPath, Path targetPath) throws IOException, InterruptedException { try (WatchService watchService = FileSystems.getDefault().newWatchService()) { watchPath.register(watchService, StandardWatchEventKinds.ENTRY_CREATE, StandardWatchEventKinds.ENTRY_MODIFY, StandardWatchEventKinds.ENTRY_DELETE); while (true) { final WatchKey key = watchService.take(); for (WatchEvent<?> watchEvent : key.pollEvents()) { final Kind<?> kind = watchEvent.kind(); if (kind == StandardWatchEventKinds.OVERFLOW) { continue; } final WatchEvent<Path> watchEventPath = (WatchEvent<Path>) watchEvent; Path systemFileDir = (Path) key.watchable(); // TODO Here can not get the real path //System.out.println(systemFileDir.toString()); // E:/aaa //System.out.println(systemFileDir.toAbsolutePath()); // E:/aaa //System.out.println(systemFileDir.toRealPath()); // E:/aaa final Path path = watchEventPath.context(); String fileAbsPath = systemFileDir + File.separator + path; Path original = Paths.get(fileAbsPath); String targetAbsPath = fileAbsPath.replace(watchPath.toString(), targetPath.toString()); Path target = Paths.get(targetAbsPath); File file = new File(targetAbsPath); if (kind == StandardWatchEventKinds.ENTRY_CREATE || kind == StandardWatchEventKinds.ENTRY_MODIFY) { if (file.isDirectory() && !file.exists()) { // 如果是目录 file.mkdirs(); } else { Files.copy(original, target, StandardCopyOption.REPLACE_EXISTING); } } if (kind == StandardWatchEventKinds.ENTRY_DELETE) { Files.delete(target); } } boolean valid = key.reset(); if (!valid) { break; } } } catch (Exception e) { e.printStackTrace(); } }。如果您需要修改它以便多次搜索相同的值，那么您可以在此处找到一些使用Do Loop的好例子：Range.FindNext Method (Excel)。

Range().FindNext

更新：OP在评论中指出有多个记录需要复制。

我修改了代码以收集数组中的数据，并在一次操作中将数据写入范围。

Sub MoveContactInfo()
    Dim Search As String
    Dim f As Range
    Dim wb As Workbook
    Search = "CWS"
    With Sheets("Master Data Set")
        Set f = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Find(What:=Search, After:=Range("A1"), LookAt:=xlWhole, MatchCase:=False)

        If Not f Is Nothing Then
            Set wb = Workbooks.Open(FileName:="D:\My Documents\Excel Spreadsheets\TEST.xls")

            If Not wb Is Nothing Then

                On Error Resume Next

                    f.EntireRow.Columns("E:J").Copy wb.Worksheets(Search).Cells(4, 1)

                On Error GoTo 0
            End If

        End If

    End With

End Sub

Answer 2

整理了一些事情。你非常接近，很长时间都在努力。

Sub MoveContactInfo()
Dim xrow As Long
Dim rng As Range

Set ws = ThisWorkbook.Sheets("Master Data Set")
Set wsDest = Workbooks.Open("D:\My Documents\Excel Spreadsheets\TEST.xlsx")
xrow = 4
ilastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
initial = "CWS"
j = 1

For i = xrow To ilastrow
    If ws.Cells(i, 1).text = initial Then
      ws.Range("E" & i & ":J" & i).Copy Destination:=wsDest.Sheets(initial).Range(Cells(j, 1), Cells(j, 6))
      j = j + 1
    End If
Next i

End Sub

根据条件将特定范围从一个工作簿复制到另一个工作簿

2 个答案: