Question

你好我对vba相当新，但我一直在努力处理代码，我需要检查sheet1上的日期是否与sheet2中的另一个匹配，如果sheet2中的相应行包含某个文本，则将数据从sheet2复制到sheet1串。任何帮助，将不胜感激。

Answer 1

我为您创建了一个包含三张（Sheet1，Sheet2和Sheet3）的Excel文件。在第一张表格中，我有如下数据：

ValueDate   Operation   User
12/08/2016  Operation1  SYS
13/08/2016  Operation2  MAN
14/08/2016  Operation3  SYS
15/08/2016  Operation4  MAN
16/08/2016  Operation5  SYS
17/08/2016  Operation6  MAN
18/08/2016  Operation7  SYS
19/08/2016  Operation8  MAN
20/08/2016  Operation9  SYS
21/08/2016  Operation10 MAN
22/08/2016  Operation11 SYS
23/08/2016  Operation12 MAN
24/08/2016  Operation13 SYS
25/08/2016  Operation14 MAN

在第二部分，我按行详细说明了操作：

Date    Code1   Code2   Code3   Code4   Obs.
12/08/2016  ABR                        Abreviation
12/08/2016       SPL                   Spelling
12/08/2016                      OTH    Others
15/08/2016              CHK            Checklist
16/08/2016  ABR                        Abreviation
17/08/2016  ABR                        Abreviation
17/08/2016       SPL                   Spelling
19/08/2016  ABR                        Abreviation

对于sheet1的每个日期，都会查找sheet2中是否存在匹配项。如果是这样，我们将找到的sheet2行复制到sheet3的新行中。这是执行此操作的VBA代码。

Sub findMatching()
Dim CurrentLine As Long, CurrentLine2 As Long, CurrentLine3 As Long
Dim MaxRows As Long, MaxRows2 As Long

MaxRows = 20
MaxRows2 = 25
CurrentLine3 = 2 '-- We start at second line because header in the first   line
'Fill Heading sheet3
Sheets(3).Cells(1, 1) = Sheets(2).Cells(1, 1)
Sheets(3).Cells(1, 2) = Sheets(2).Cells(1, 2)
Sheets(3).Cells(1, 3) = Sheets(2).Cells(1, 3)
Sheets(3).Cells(1, 4) = Sheets(2).Cells(1, 4)
Sheets(3).Cells(1, 5) = Sheets(2).Cells(1, 5)
For CurrentLine = 1 To MaxRows '-- Loop in first sheet (read data)
    For CurrentLine2 = 1 To MaxRows2 '-- Loop in second sheet (compare data)
      If Sheets(1).Cells(CurrentLine, 1) = Sheets(2).Cells(CurrentLine2, 1) Then
      '-- copying matching data
    Sheets(3).Cells(CurrentLine3, 1) = Sheets(2).Cells(CurrentLine2, 1)
    Sheets(3).Cells(CurrentLine3, 2) = Sheets(2).Cells(CurrentLine2, 2)
    Sheets(3).Cells(CurrentLine3, 3) = Sheets(2).Cells(CurrentLine2, 3)
    Sheets(3).Cells(CurrentLine3, 4) = Sheets(2).Cells(CurrentLine2, 4)
    Sheets(3).Cells(CurrentLine3, 5) = Sheets(2).Cells(CurrentLine2, 5)
    CurrentLine3 = CurrentLine3 + 1
  End If
   Next CurrentLine2
 Next CurrentLine
 '-- If the date in the first column isn't formatted well.
 Sheets(3).Columns("A:A").Select
 Selection.NumberFormat = "m/d/yyyy"
 Sheets(3).Range("A1").Select
End Sub

结果

Date    Code1   Code2   Code3   Code4
12/08/2016  ABR         
12/08/2016        SPL       
12/08/2016                      OTH
15/08/2016              CHK 
16/08/2016  ABR         
17/08/2016  ABR         
17/08/2016        SPL       
19/08/2016  ABR

希望这有帮助！

Answer 2

   <code>
    With SrchRng
Range("H22").Select
Do Until i = 120
If InStr(1, Cells(j, 8), Srchwrd) < 0 And Activecells.Offset(0, -6).Value
Master.Cells(i, 2) Then _
  Master.Cells(i, 3).Value = Cells(j, 8).Offset(0, -2).Value _
 And i = i + 1
   j = j + 1

         If NCB.Cells(j, 2).Value <> Master.Cells(i, 2).Value _
   Then Master.Cells(i, 3).Value = "No Entry Today"
  i = i + 1
 j = j + 1

用于检查日期是否匹配的Vba宏，如果相应的行包含字符串，则将数据复制到shet

2 个答案: