合并来自两张不同工作表的文本

Question

如果在这两张工作表中的某些值之间存在匹配，我正在关注如何合并工作簿中两张不同工作表的文本。

我有两张表，延迟和DRG。我想将文本从“DRG”列E合并到“延迟”列表列P（行可能已经有文本，但来自“DRG”列E的文本应与分号合并）。下面的代码进行匹配并更新CO10中的某个文本，我想添加合并部分以及此代码） 如果在“等待时间”的列A和“DRG”的列B中存在匹配，则文本在“DRG”的E栏中应该合并到“Latency”表的Col P（特定行）中。

欢迎任何更好的方式来做到这一点。

Sub PassFailValidation() 

Dim Rng As Range, cl As Range 
Dim LastRow As Long, MatchRow As Variant 

With Sheets("DRG") 
    LastRow = .Cells(.Rows.count, "C").End(xlUp).Row '<-- find last row with data in column C 
    Set Rng = .Range("C2:C" & LastRow) '<-- set range in Column C 
End With 

With Sheets("Latency") 
    For Each cl In .Range("B2:B" & .Cells(.Rows.count, "B").End(xlUp).Row) ' loop through all cells in Column B 
     MatchRow = Application.Match(cl.Value, Rng, 0) ' find match with values in Colummn C as in "DRG" sheet 
     If Not IsError(MatchRow) Then ' <-- successful match 

      Select Case Sheets("DRG").Range("D" & MatchRow + 1).Value 'Set D as the cell whch has the value 
       Case "Approved" 
        .Range("O" & cl.Row).Value = "Pass" 

       Case "Pended" 
        .Range("O" & cl.Row).Value = "Fail" 

       Case "In progress" 
        .Range("O" & cl.Row).Value = "In progress" 
      End Select 
     End If 
    Next cl 
End With 

末次

Answer 1

只需添加：

If Not Sheets("DRG").Range("E" & MatchRow + 1).Value = vbNullString Then .Range("P" & cl.row).Value = Range("P" & cl.row).Value & IIf(Not Range("P" & cl.row).Value = vbNullString, ";", "") & Sheets("DRG").Range("E" & MatchRow + 1).Value 

如下

Sub PassFailValidation() 

    Dim Rng As Range, cl As Range 
    Dim LastRow As Long, MatchRow As Variant 

    With Sheets("DRG") 
     LastRow = .Cells(.Rows.Count, "C").End(xlUp).row '<-- find last row with data in column C 
     Set Rng = .Range("C2:C" & LastRow) '<-- set range in Column C 
    End With 

    With Sheets("Latency") 
     For Each cl In .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).row) ' loop through all cells in Column B 
      MatchRow = Application.Match(cl.Value, Rng, 0) ' find match with values in Colummn C as in "DRG" sheet 
      If Not IsError(MatchRow) Then ' <-- successful match 
       Select Case Sheets("DRG").Range("D" & MatchRow + 1).Value 'Set D as the cell whch has the value 
        Case "Approved" 
         .Range("O" & cl.row).Value = "Pass" 

        Case "Pended" 
         .Range("O" & cl.row).Value = "Fail" 

        Case "In progress" 
         .Range("O" & cl.row).Value = "In progress" 
       End Select 
       If Not Sheets("DRG").Range("E" & MatchRow + 1).Value = vbNullString Then .Range("P" & cl.row).Value = .Range("P" & cl.row).Value & IIf(Not .Range("P" & cl.row).Value = vbNullString, ";", "") & Sheets("DRG").Range("E" & MatchRow + 1).Value 
      End If 
     Next cl 
    End With 

End Sub 

Answer 2

我相信这个问题会吸引一些伟大的VBA编码的答案。但是，可以使用数据库引擎技术来解决这些问题。看到这对于初学者https://support.microsoft.com/en-gb/help/278973/excelado-demonstrates-how-to-use-ado-to-read-and-write-data-in-excel-workbooks