Question

我正在处理无组织的数据。我正在处理包含合并和拆分的文件夹信息数据的工作表“ FileListd”。例如：

From: 158265 To: 52154 48546 514562 84562 158265
From: 48946 To: 52174 48946 515562 89562 158265
From: 52154 52174 48946 To: 515462 89572 48546

我有一个文件夹编号列表，例如：52154 48546 514562 84562 158265从“测试”表的Col A1：A1000第一行开始的编号。如果我必须在合并的工作表中找到52154，并在同一行中查找“ To：”，然后将“ To：”旁边的数据复制到工作表“ FileListd”的最后一列到工作表“ Test” .cel.offset（2 ）。

我设法在下面移植了宏，该宏可完成第一阶段任务，即在工作表“ FileListd”中找到所需的编号，并为下一个搜索“ To：”定义搜索区域。但是，如果没有To :，首先，它将从列表中查找另一个数字。在找到“收件人：”之前，我无法寻找相同的号码。在某些情况下，根本找不到“收件人：”，应该在工作表“测试”列表中搜索另一个数字。有办法吗？

    Sub FurtherDataDigger()

    Dim mynum As Variant
    Dim startCell As Range
    Dim rng1 As Range
    Dim lastcol As Long
    Dim searchRange As Range
    Dim matchFound As Range
    Dim searchArea As Range
    Dim cel As Range

   With Sheets("Test")
   Set rng1 = .Range("A1:A1000")
   For Each cel In rng1
   If cel.Text <> "" Then
   mynum = cel.Text

  With Sheets("filelistd")
  Set searchArea = Sheets("Filelistd").UsedRange
    Set startCell = searchArea.Find(mynum, , xlValues, xlWhole, 
   xlByRows, xlNext, False)
   lastcol = 

 Sheets("Filelistd").UsedRange.SpecialCells(xlCellTypeLastCell).Column
  firstaddress = startCell.Address

     Set searchRange = Range(Cells(startCell.Row, 
   startCell.Column), Cells(startCell.Row, lastcol))
     Set matchFound = searchRange.Find("TO:", , xlValues, 
   xlPart, xlByRows, xlNext, False)

   If Not matchFound Is Nothing Then

        Do
     Sheets("Filelistd").Range(Cells(matchFound.Row, 
   matchFound.Column), Cells(matchFound.Row, lastcol)).Copy
    Sheets("Test").Range(cel.Offset(0, 2)).PasteSpecial 
   Transpose:=True
    If matchFound.Text = "" Then
    Set startCell = .FindNext(startCell)
    End If

   Set startCell = .FindNext(startCell)
   Loop While Not startCell Is Nothing And startCell.Address 
  <> firstaddress

    End If
   End With
   End If
   Next
   End With

End Sub

从另一个工作表中找到并复制找到范围内的特定数据

0 个答案: