如上图所示，要修改如下代码里的哪一句才能生成对方科目呢？谢谢！
Sub XXL凭证生成对方科目()
Dim data, i&, dic, temp, X&
data = ThisWorkbook.Worksheets("XXL").UsedRange.Value
Set dic = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(data)
If InStr(dic(data(i, 1) & data(i, 2)), data(i, 4)) = 0 Then
If data(i, 5) <> "" Then
If dic(data(i, 1) & data(i, 2)) = "" Then
dic(data(i, 1) & data(i, 2)) = data(i, 4) & "|"
Else
temp = Split(dic(data(i, 1) & data(i, 2)), "|")
If temp(0) = "" Then
temp(0) = data(i, 4)
Else
temp(0) = temp(0) & "，" & data(i, 4)
End If
dic(data(i, 1) & data(i, 2)) = Join(temp, "|")
End If
Else
If dic(data(i, 1) & data(i, 2)) = "" Then
dic(data(i, 1) & data(i, 2)) = "|" & data(i, 4)
Else
temp = Split(dic(data(i, 1) & data(i, 2)), "|")
If temp(1) = "" Then
temp(1) = data(i, 4)
Else
temp(1) = temp(1) & "，" & data(i, 4)
End If
dic(data(i, 1) & data(i, 2)) = Join(temp, "|")
End If
End If
End If
Next i
For i = 2 To UBound(data)
If data(i, 5) <> "" Then X = 1 Else X = 0
data(i, 8) = Split(dic(data(i, 1) & data(i, 2)), "|")(X) '刮号里的数字表示列号，第一个括号里的8则表示为第8列，生成的对方科目放在此列。
Next i
ThisWorkbook.Worksheets("XXL").[A1].Resize(UBound(data), UBound(data, 2)) = data
End Sub

同类问题：https://club.excelhome.net/thread-1313448-1-5.html

市面上的公式和那些vba代码都用过，直接上最终结论，唯一真神只有方方格子出的audtool审计专版，准确匹配。下至费用勾稽，上至借贷方发生额分析，一步到位。

不是修改你的代码，用数组方法；除了多对多速度还行，具体自己看吧
vba参考：https://blog.csdn.net/hhhhh_51/article/details/130957929

不懂这一行业，就先猜一猜。
Public Function duifang(pingzheng, kemu, ke)
Dim pz, km, y&, zihao
pz = pingzheng
km = kemu
zihao = ke.Offset(0, pingzheng.Column - ke.Column)
For y = 1 To UBound(pz)
If pz(y, 1) = zihao Then
If km(y, 1) <> ke Then
duifang = km(y, 1)
Exit Function
End If
End If
Next
End Function

Public Function duifang2(pingzheng, kemu, ke)
Dim pz, km, y&, zihao
pz = pingzheng
km = kemu
zihao = ke.Offset(0, pingzheng.Column - ke.Column)
For y = 1 To UBound(pz)
If pz(y, 1) = zihao Then
If km(y, 1) <> ke Then
duifang2 = duifang2 & "," & km(y, 1)
End If
End If
Next
duifang2 = Right(duifang2, Len(duifang2) - 1)
End Function

针对10楼的图：
G2单元格的公式：=wanglai(D2)
H2单元格的公式：=duifang(B2,B$2:B$29,D$2:F$29)
i2单元格的公式：=yiji(D2)
代码如下（要把8楼和9楼的代码删除掉）：
Public Function wanglai(kemuo) '往来明细(科目单元格)
If InStr(kemuo, "应收账款") + InStr(kemuo, "应付账款") + _
InStr(kemuo, "预收账款") + InStr(kemuo, "预付账款") > 0 Then
wanglai = Replace(kemuo, Split(kemuo, "-")(0) & "-", "")
Else
wanglai = ""
End If
End Function
Public Function duifang(zihao, pingzheng, kemuo_jie_dai)
'对方科目(字号单元格,凭证字号1列区域，科目+借方金额+贷方金额相连的3列区域）
Dim zh, pz, kjd, K&, jie
#, dai#
, jie2
#, dai2#
, y&, yJ, D
zh = zihao
pz = pingzheng
kjd = kemuo_jie_dai
K = zihao.Row - pingzheng.Row + 1
jie = kjd(K, 2)
dai = kjd(K, 3)
Set D = CreateObject("scripting.dictionary")
For y = 1 To UBound(pz)
If (pz(y, 1) = zh) And (y <> K) Then
jie2 = kjd(y, 2)
dai2 = kjd(y, 3)
If (jie * jie2 < 0) + (jie * dai2 <> 0) + (dai * dai2 < 0) + (dai * jie2 <> 0) Then
yJ = yiji(kjd(y, 1))
If Not D.exists(yJ) Then
D(yJ) = 1
duifang = duifang & "/" & yJ
End If
End If
End If
Next
duifang = Right(duifang, Len(duifang) - 1)
End Function
Public Function yiji(kemuo) '一级科目(科目单元格)
Dim n%
For n = 0 To 9
kemuo = Replace(kemuo, n, "")
Next
yiji = Trim(Split(kemuo, "-")(0))
End Function