Question

这是一个单元格CVSS2#AV:N/AC:L/Au:N/C:P/I:P/A:P我想迭代它，作为一个例子：

if cell contains AV:N then
    write in another workbook Network(N)
else if cell contains AV:A then
    write in another workbook Adjacent(A)

这应该检查所有可能性，并且应该在一定范围的列中完成。

谢谢大家。

Answer 1

您向我们提供的信息很少，关于您的范围所在的位置以及您要写入的工作簿及其范围，但我会尝试为您提供一种方法来实现您想要实现的目标：

Sub foo()
Dim ws As Worksheet: Set ws = ThisWorkBook.Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Dim IsOpen As Boolean

IsOpen = IsWorkBookOpen("C:\Network(N).xlsx") 'check if workbook is open
If Not IsOpen Then
    Workbooks.Open ("C:\Network(N).xlsx") 'if not already open, then open it
End If

Dim wbNet As Workbook: Set wbNet = Workbook("C:\Network(N).xlsx")
Dim wsNet As Worksheet: Set wsNet = wbNet.Sheets("Sheet1")

IsOpen = IsWorkBookOpen("C:\Adjacent(A).xlsx") 'check if workbook is open
If Not IsOpen Then
    Workbooks.Open ("C:\Adjacent(A).xlsx") 'if not already open, then open it
End If

Dim wbAdj As Workbook: Set wbAdj = Workbook("C:\Adjacent(A).xlsx")
Dim wsAdj As Worksheet: Set wsAdj = wbAdj.Sheets("Sheet1")

For i = 2 To LastRow 'loop from row 2 to last on your worksheet in Column A
    If InStr(ws.Cells(i, 1), "AV:N") > 0 Then 'if "AV:N" found then
        NetworkLast = wsNet.Cells(wsNet.Rows.Count, "A").End(xlUp).Row + 1
        'find the next free row on this worksheet
        wsNet.Cells(NetworkLast, 1).Value = ws.Cells(i, 1) 'pass the contents of your cell to that worksheet
    ElseIf InStr(ws.Cells(i, 1), "AV:A") > 0 Then
        AdjacentLast = wsAdj.Cells(wsNet.Rows.Count, "A").End(xlUp).Row + 1
        wsAdj.Cells(AdjacentLast, 1).Value = ws.Cells(i, 1)
    End If
Next i
End Sub

Function IsWorkBookOpen(Name As String) As Boolean
    Dim xWb As Workbook
    On Error Resume Next
    Set xWb = Application.Workbooks.Item(Name)
    IsWorkBookOpen = (Not xWb Is Nothing)
End Function

检查单元格是否包含某些文本并在其他工作簿中写入文本

1 个答案: