シート2の列のセルの値がシート1で一致するかどうかを調べるVBAコード。シート2のセルをコピーする

Question

VBAを初めて使用していて、私が解決しようとしている問題があります。私は静的なデータ（Sheet1）と呼ばれるシートを持っています。顧客名、顧客ID、および列を使用してケースを識別します。フレックスデータ（Sheet2）には、顧客ID、ユースケース、ステータスがありました。私は、各顧客のステータスを対応するユースケースの列/セルにコピーするVBAコードを考え出しています。シート1の顧客と照合できないシート2のデータは、別のシートにコピーする必要があります。 ご協力いただければ幸いです。以下は

は、シートが

シート1つの静的データ

Customer Name | Customer ID | Case 1 | Case 2 | Case 3 | Case 4 | Case 5 
------------------------------------------------------------------------ 
Customer A | 111   |  |  |  |  | 
Customer B | 222   |  |  |  |  | 
Customer C | 333   |  |  |  |  | 
Customer D | 444   |  |  |  |  | 
Customer E | 555   |  |  |  |  | 

シート2つのFlexデータ

Customer ID | Use Case | Status 
--------------------------------- 
111   |Case 1 | Forecast 
222   |Case 1 | Upside 
111   |Case 2 | Upside 
333   |Case 3 | Pipeline 
444   |Case 4 | Pipeline 
222   |Case 4 | Forecast 
666   |Case 5 | Pipeline 

出力シートやシート1

Customer Name | Customer ID | Case 1 | Case 2 | Case 3 | Case 4 | Case 5 
------------------------------------------------------------------------ 
Customer A | 111   |Forecast|Upside |  |  | 
Customer B | 222   |Upside |  |  |Forecast| 
Customer C | 333   |  |  |Pipeline|  | 
Customer D | 444   |  |  |  |Pipeline| 
Customer E | 555   |  |  |  |  | 

Answer 1

OKこれをVBAで実行できるかどうかを確認できます。 ここにVBAの潜在的な解決策があります。これはすばやく汚れていますが、仕事は終わりです。これは、sheet1とSheet2に依存します。

Sub MatchCustomersToCase() 

Dim lookUpValue 

'step 1 select sheet 1 the spreadsheet. 
Sheet1.Select 

'step 2 loop customer id 

For I = 1 To 12 

Set workingcell = Worksheets("Sheet1").Cells(I, 2) 
lookUpValue = workingcell.Value 
cellAddress = workingcell.Address() 

'select sheet 2 
Sheet2.Select 

'find the value in sheet 2 
Call Find_value_in_sheet2(lookUpValue, cellAddress) 


Next 
End Sub 



Sub Find_value_in_sheet2(somevalue, fromAddress) 
    Dim FindString As String 
    Dim Rng As Range 
    Dim caseType As String 
    Dim CaseValue As String 
    Dim listOfValues As Variant 

    listOfValues = Array(somevalue) 

    If Trim(somevalue) <> "" Then 
     With Sheets("Sheet2").Range("A:A") 

      For I = LBound(listOfValues) To UBound(listOfValues) 

      Set Rng = .Find(What:=listOfValues(I), _ 
          After:=.Cells(.Cells.Count), _ 
          LookIn:=xlValues, _ 
          LookAt:=xlWhole, _ 
          SearchOrder:=xlByRows, _ 
          SearchDirection:=xlNext, _ 
          MatchCase:=False) 
      If Not Rng Is Nothing Then 
      FirstAddress = Rng.Address 
      Do 

       Application.Goto Rng, True 

       caseType = Rng.Offset(0, 1).Value 

       If Trim(caseType) = "Case 1" Then 
        CaseValue = Rng.Offset(0, 2).Value 
        Sheet1.Range(fromAddress).Offset(0, 1).Value = CaseValue 

       ElseIf Trim(caseType) = "Case 2" Then 
       CaseValue = Rng.Offset(0, 2).Value 
        Sheet1.Range(fromAddress).Offset(0, 2).Value = CaseValue 

       ElseIf Trim(caseType) = "Case 3" Then 
       CaseValue = Rng.Offset(0, 2).Value 
        Sheet1.Range(fromAddress).Offset(0, 3).Value = CaseValue 

       ElseIf Trim(caseType) = "Case 4" Then 

       CaseValue = Rng.Offset(0, 2).Value 
        Sheet1.Range(fromAddress).Offset(0, 4).Value = CaseValue 

       ElseIf Trim(caseType) = "Case 5" Then 

       CaseValue = Rng.Offset(0, 2).Value 
        Sheet1.Range(fromAddress).Offset(0, 5).Value = CaseValue 

       End If 

      Set Rng = .FindNext(Rng) 
      Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress 
       End If 
      Next I 
     End With 
    End If 
End Sub 

Answer 2

あなたの組み立て方法ですmulを使うことができますTI-基準インデックス/マッチ：

=Index([Status Range],Match([customer ID]&[Case No.],[customer ID Range]&[Case No. Range],0)

Ctrl + Shiftキーで、配列数式として入力+その後

を入力して、最終的に何かを隠すために周り=IfError([index/match],"")を包みます。

私の例のように、参照をアンカーに確認してください：

だからあなただけの別のページにデータを参照してくださいよ、私はちょうど示しやすくするために同じ上に置きます。

Answer 3

あなたはこの試みることができる：あなたのコードしようとしている

Sub main() 
    Dim cell1 As Range, cell2 As Range, flexRng As Range, filteredRng As Range, headersRng As Range 

    With Worksheets("Sheet 2") 
     Set flexRng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) 
    End With 

    With Worksheets("Sheet 1") 
     Set headersRng = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)) 
     For Each cell1 In .Range("B2", .Cells(.Rows.Count, 2).End(xlUp)) 
      If GetFilteredRange(flexRng, cell1.Value, filteredRng) Then 
       For Each cell2 In filteredRng 
        .Cells(cell1.Row, headersRng.Find(what:=cell2.Offset(, 1).Value, LookIn:=xlValues, lookat:=xlWhole).Column).Value = cell2.Offset(, 2) 
       Next 
      End If 
     Next 
    End With 
End Sub 

Function GetFilteredRange(rangeToFilter As Range, filterValue As Variant, filteredRange As Range) As Boolean 
    With rangeToFilter 
     .AutoFilter Field:=1, Criteria1:=filterValue 
     If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then 
      GetFilteredRange = True 
      Set filteredRange = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) 
     End If 
     .Parent.AutoFilterMode = False 
    End With 
End Function