用多个细胞替换细胞内容

Question

有没有办法用多个细胞替换细胞并让它们与其他多个细胞替代相关？以下示例显示了工作表A第一行的替换。

工作表A：

使用工作表B中的替换逻辑，其中A列中的项应替换为B列中的相应项。无处不在zd，它应该变为a_zd，b_zd和y_zd。无处不在使用fs，它应该变成c_fs，y_fs和z_fs。示例：A1 = zd，B1 = a_zd; A2 = zd和B2 = b_zd; A3 = zd和B3 = y_zd; A4 = fs，B4 = c_fs; A5 = fs，B5 = y_fs; A6 = fs和B6 = z_fs：

工作表A中第一行的替换将具有工作表C的结果。示例：A1 = a_zd和B1 = c_fs; A2 = a_zd，B2 = y_fs; A3 = a_zd，B3 = z_fs; A4 = b_zd，B4 = c_fs; A5 = b_zd，B5 = y_fs; A6 = b_zd和B6 = z_fs; A7 = y_zd和B7 = c_fs; A8 = y_zd和B8 = y_fs; A9 = y_zd和B9 = z_fs;：

Answer 1

Option Explicit

Sub CombineData()
    Dim myInput As Range
    Dim myOutput As Range
    Dim inputTwoValues As Collection
    Dim output1 As Collection
    Dim output2 As Collection
    Dim anOutput1 As Variant
    Dim anOutput2 As Variant

    Set myInput = Worksheets("Sheet1").Range("A1")
    Set myOutput = Worksheets("Sheet3").Range("A1")

    Do
        Set output1 = GetRelatedValues(myInput.Value)
        Set output2 = GetRelatedValues(myInput.Offset(0, 1).Value)
        For Each anOutput1 In output1
            For Each anOutput2 In output2
                myOutput.Formula = anOutput1
                myOutput.Offset(0, 1).Formula = anOutput2
                Set myOutput = myOutput.Offset(1, 0)
            Next
        Next
        Set myInput = myInput.Offset(1, 0)
    Loop While myInput.Value <> ""
End Sub


Function GetRelatedValues(myInput As Variant) As Collection
    Dim returnVal As New Collection
    Dim myRelationship As Range
    Set myRelationship = Worksheets("Sheet2").Range("A1")

    While myRelationship.Value <> ""
        If myRelationship.Value = myInput Then
            returnVal.Add (myRelationship.Offset(0, 1).Value)
        End If
        Set myRelationship = myRelationship.Offset(1, 0)
    Wend
    Set GetRelatedValues = returnVal
End Function