- ©«¤l
- 234
- ¥DÃD
- 19
- ºëµØ
- 0
- ¿n¤À
- 276
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows XP
- ³nÅ骩¥»
- office 2003
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-1-7
- ³Ì«áµn¿ý
- 2021-10-7
|
¦^´_ 1# agietron
§Ú¤]¨Ó½m²ß¤@¤U,¸Õ¸Õ¬Ý
Sub ex()
Dim arr As Variant, a As Variant, b As Variant
Dim d As Object, x%, y%, DSC%
Set d = CreateObject("scripting.dictionary")
DSC = InputBox("¿é¤J§é¦©%", "§é¦©", "60")
With Sheets("¤u§@ªí1")
With .Range(.[a1], [k1].End(4))
.Borders.LineStyle = xlLineStyleNone
.UnMerge
.ClearContents
End With
For Each a In .Range(.[O1], .[O1].End(4))
If Not d.exists(a.Value) Then d(a.Value) = ""
Next
End With
For x = 1 To Sheets.Count - 1
With Sheets(x)
For Each a In .UsedRange
If d.exists(a.Value) Then
For Each b In Array(Array("C", "S220"), Array("M", "M520"), Array("N", "N620"), Array("A", "S220²k±µ"), Array("H", "HSS"), Array("K", "HSS-Co"), Array("S", "SKH"))
If b(0) = Left(a.Value, 1) Then d(a.Value) = b(1): Exit For
Next
arr = Array(.[a1] & "--" & .Name & "²Ä" & a.Row & "¦C", Chr(10))
For y = 1 To .[a2].End(2).Column
ReDim Preserve arr(0 To UBound(arr) + 1)
arr(UBound(arr)) = .Cells(2, y) & "*" & .Cells(a.Row, y) & " "
Next
d(a.Value) = Array(d(a.Value), Join(arr, ""), "", "", "", "", "", "=Roundup((" & a.Offset(, 1).Value & " * " & DSC / 100 & "), -1)", "", a.Value)
End If
Next
End With
Next
With Sheets("¤u§@ªí1")
.[b1].Resize(d.Count, 10) = Application.Transpose(Application.Transpose(d.items))
With .Range([a1], [k1].End(4))
For x = 1 To .Rows.Count
.Cells(x, 1) = x
.Cells(x, 3).Resize(, 5).Merge
.Cells(x, 10) = "=Sum(I" & x & "*H" & x & ")"
Next
.Borders.LineStyle = xlContinuous
End With
End With
End Sub |
|