|
加个判断就行了。
- Sub Mass_TRY()
- Dim i&, j&, r&, c&, arr, n&, d As Object, rngr As Range, rngc As Range
- Set d = CreateObject("scripting.dictionary")
- With Sheets("Code")
- r = .[a65536].End(3).Row + 1
- c = .Cells(2, 16384).End(1).Column
- For j = 2 To c Step 11
- .Cells(3, j).Resize(r - 2, 10).ClearContents
- .Cells(3, j).Resize(r - 2, 10).Interior.Pattern = xlNone
- Next j
- arr = Range("e2:o" & [e65536].End(3).Row)
- For i = 1 To UBound(arr)
- If arr(i, 7) > 5 Then arr(i, 7) = 5
- If arr(i, 11) > 5 Then arr(i, 11) = 5
- Next i
- For i = 1 To UBound(arr)
- Set rngr = .Columns(1).Find(arr(i, 2), lookat:=xlWhole)
- Set rngc = .Rows(1).Find(arr(i, 1), lookat:=xlWhole)
- If Not rngr Is Nothing And Not rngc Is Nothing Then
- r = rngr.Row
- c = rngc.Column
- .Cells(r, c).Offset(, arr(i, 7) - 1) = .Cells(r, c).Offset(, arr(i, 7) - 1) + 1
- .Cells(r, c).Offset(, arr(i, 11) + 4) = .Cells(r, c).Offset(, arr(i, 11) + 4) + 1
- If Not d.exists(arr(i, 1) & "," & arr(i, 2)) Then
- d(arr(i, 1) & "," & arr(i, 2)) = ""
- For j = 1 To UBound(arr)
- If arr(j, 1) = arr(i, 1) Then
- .Cells(r - 1, c).Offset(, arr(j, 7) - 1) = .Cells(r - 1, c).Offset(, arr(j, 7) - 1) + 1
- .Cells(r - 1, c).Offset(, arr(j, 11) + 4) = .Cells(r - 1, c).Offset(, arr(j, 11) + 4) + 1
- End If
- If arr(j, 2) = arr(i, 2) Then
- .Cells(r + 1, c).Offset(, arr(j, 7) - 1) = .Cells(r + 1, c).Offset(, arr(j, 7) - 1) + 1
- .Cells(r + 1, c).Offset(, arr(j, 11) + 4) = .Cells(r + 1, c).Offset(, arr(j, 11) + 4) + 1
- End If
- Next j
- End If
- End If
- Next i
- End With
- End Sub
复制代码
|
|