|
没作调试,仅从代码简化的角度改了一下:- Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
- Dim Sh As Worksheet
- Cells.Select
- Selection.ClearContents
- Set Sh = Sheet2
- Sh.Cells.Interior.ColorIndex = 0
- 'clear sheet
- Sh.Cells(1, 1) = "Material ID"
- Sh.Cells(1, 3) = "Result"
- With Sheet1
- hv = .[a1].End(xlDown).Row
- sv = .[a1].End(xlToRight).Column
- 'find the coordinate of the last horizontal(hv) and vertical line(sv)
- .Cells(1, 2).Resize(1, sv - 1).Interior.ColorIndex = 0
- 'clear the sheet1's cells'color
- Sh.[a2].Resize(hv - 1).Value = .[a2].Resize(hv - 1).Value
- 'creat the final form
- cv = .Cells(3, .Columns.Count).End(xlToLeft).Column
- For n = 2 To sv
- For m = 8 To cv
- If .Cells(1, n) = .Cells(3, m) Then .Cells(1, n).Interior.ColorIndex = 38
- Next
- Next
- 'mark with color of the parameters'cell which we don't compare,here for example i choose weight would not be compared
- blank = 0
- For n = 2 To sv
- If .Cells(1, n).Interior.ColorIndex = 38 Then blank = blank + 1
- Next
- 'blank is the number of the parameter which we don't compare
- xxx = .Cells(2, "h"): mystr = " empties more than " & xxx
- For i = 2 To hv
- o = 0
- emp = 0
- For n = 2 To sv
- If .Cells(i, n) = "" And .Cells(1, n).Interior.ColorIndex <> 38 Then
- emp = emp + 1
- If emp > xxx Then Sh.Cells(i, 3) = mystr
- End If
- Next n
- Next i
- 'compare each material's empties with the limit value
- 'when the number greater than limit value,the material won't be compared with others
- For i = 2 To hv - 1
- If Sh.Cells(i, 3) <> mystr Then
- o = 0
- For j = i + 1 To hv
- If Sh.Cells(j, 3) <> mystr Then
- p = 0
- For n = 2 To sv
- If .Cells(1, n).Interior.ColorIndex <> 38 Then
- If .Cells(i, n) <> .Cells(j, n) And .Cells(i, n) <> "" And .Cells(j, n) <> "" Then
- com = 0
- Exit For
- Else
- com = 1
- If .Cells(i, n) = "" Or .Cells(j, n) = "" Then p = p + 1
- 'get the number of blanks
- End If
- End If
- Next
- 'find the possibility of if two materials the same one are
-
- If com = 1 Then
- Sh.Cells(i, 3 + o) = .Cells(j, 1) & "(" & p & "/" & sv - 1 - blank & ")"
- o = o + 1
- End If
- End If
- Next j
- End If
- Next i
- End Sub
复制代码 |
|