Excel-VBAの別の値と同じ行の関連する値をカウントする

Question

識別された値と同じ行にある値を数える際に問題があります。テーブルには、画像に示されているのと同じ正確な値が表示されます。これらの値が互いに何回関連しているかを示す表を生成します。相続人は、私がこれまでに得たものを私のコードは本当に厄介ですし、Excel VBAでイム本当に良いではない：

Sub Button1_Click() Dim cell As Range, f As Range 
Dim rowOffset As Long 

With Worksheets("Sheet1").Range("A3:F2000") '<--| change this to your actual range of interest 

    For Each cell In .SpecialCells(xlCellTypeConstants, xlNumbers) 

     rowOffset = 0 '<--| rowOffset was once set to 1 

     Set f = .Find(what:=cell, after:=cell, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious) 

     If Not f Is Nothing And f.Row <= cell.Row Then rowOffset = cell.Row - f.Row '<--| if Data has occurred is assumed, add + 1 after this line of codes here. 

     Worksheets("gapByRow").Cells(cell.Row, cell.Column).Value = rowOffset 

    Next cell 
End With End Sub 

例怒鳴るは値が関連付けられている時間を示す表があります。黄色い背景のセルは「識別された値」であり、緑色のセルは関連するものです。あなたが見ることができるように、黄色の背景に8があり、その横に5,1,0,0,3,2,5,7などの値があります。これは、8が5回に1回、1回に2回、 0で3、0で4、5で3、6で2など。 vbaコードが正しい場合は、ここで同じ結果が表示されます。

Answer 1

代わりに、私はそれUDFになるだろうボタンで、式のように呼び出すことができます。

Function MyCount(Rng As Range, xVal, Yval) 
Application.Volatile 
Dim rngArr() As Variant 
rngArr = Rng.Value 
For i = 1 To UBound(rngArr, 1) 
    For j = 1 To UBound(rngArr, 2) 
     If rngArr(i, j) = xVal Then 
      For k = 1 To UBound(rngArr, 2) 
       If rngArr(i, k) = Yval Then MyCount = MyCount + 1 
      Next k 
     End If 
    Next j 
Next i 

End Function 

あなたはI3でこれを置くでしょう：

=MyCount($A$3:$F$17,$H3,I$2) 

次に、行列を上下にコピーします。

私はその後、計算書を作成し、データが更新された後にF9を打つでしょう。