[µo°Ý] ¸ê®Æ¤ñ¹ï«á¶ñ¤J¬ÛÀ³¸ê®Æ¥H¤Î¤½¦¡

agietron

[attach]33163[/attach]
¦U¦ì¥ý¶i­Ì¦n
²Ä¤@¦¸¤W½×¾Âµo°Ý¡A¦p¦³Â§»ª¤£©P½Ð®ü²[
¦b¤U¥Î§Ú¦³­­ª¾ÃѼgªºVBA¡A
­ì©l¸ê®Æ±Nªñ300­Ó¬¡­¶(¬¡­¶ÁÙ·|Ä~Äò¼W¥[)¡A¤ñ¹ï®É¸g±`·|¦³´X¦Êµ§¸ê®Æ¡A
¦]¦¹¦b§@¤ñ¹ï¸ê®Æªº®É­Ô©Ò»Ý®É¶¡«Üªø
¦]¦¹¡A¤W¨Ó´£°Ý¡A§Æ±æ¥i¥H¼W¶i¥ÎVBA³B²z¸ê®Æªº¯à¤O
§Æ±æ¥ý¶i­ÌÀ°¦£
¦p½d¨ÒÀɮפ¤ªº¦p½d¨ÒÀɮפ¤ªº"¤u§@ªí1"¤ºªº"OÄæ"¬°­n¬d¸ßªº¸ê®Æ¶µ¥Ø
¥¨¶°"Sub SEARCH_aLL()"¤º®e§Æ±æ³Â·Ð¥ý¶i­Ì¨ó§U§ï¶i
ÁÂÁ¦U¦ì

°a¤ªºµ

¦^´_ 1# agietron

½Ð°Ý agietron ¤j¤j  ³o¤½¦¡ ¬O¥[Á`¬Æ»ò?
Sheets(Sh).Cells(VR, 10).Formula = "=sum(i" & VR & "*h" & VR & ")"
¬O¤£¬O iÄæ * HÄæ  ?
¥i§_»¡©ú¤@¤U  ·PÁÂ

agietron

¦^´_ 2# °a¤ªºµ
ºµ¤j
ÁÂÁ±zÃö¤Á
¸Óºâ¦¡¬O­pºâ"¤u§@ªí1"¤ºªº¤u§@ªí1"¤ºªº"I"Äæ¦ì*"H"Äæ¦ì
¹w¥ý¶ñ¤J¤½¦¡¬°¤F¤è«K¶ñ¤J¼Æ¶q«áºâ¥X¤p°Oª÷ÃB¥Îªº
³Ò¾r±z¤F¯u·PÁ±z

­ã´£³¡ªL

¦^´_ 1# agietron


§â»Ý¨D³W«h¤Î¬yµ{»¡²M·¡,
§O¤HµLªk¥Î§Aªºµ{¦¡¥h¸ÑŪ~~

agietron

¥Î"¤u§@ªí1"OÄ椺®e¤ñ¹ï¤u§@ªíP39-P139ªº¤º®e«á¡A´£¨ú¤ñ¹ï¦¨¥\ªº¤u§@ªíÄæ¦ì¸ê°T¡A»s§@¥XÀHªþÀÉ®×°õ¦æ«á¤º®e
¤ñ¹ï«e:

¤U¸ü (105.57 KB)

2021-4-5 13:48

¤ñ¹ï«á:

¤U¸ü (139.71 KB)
¤ñ¹ï«á

2021-4-5 13:49

°a¤ªºµ

¦^´_ 5# agietron

¦³ªÅÀ°§Ú¸Õ¸Õ¬Ý ¬O¤£¬O§A­nªº ¦ý§Ú¤£½T©w¬O¤£¬O¥¿½T ¦]¬°§Úªºµ²ªG¸ò§Aªºµ²ªG¤£¤@¼Ë  ¦Ó¥B°j°é¤]¤ñ¸û¦h ¬Ý¬Ý¦³¨S¦³¤j¤jÄ@·NÀ°¦£

1. Public Sub ¸ó¤u§@ªí¤ñ¹ï½m²ß()
   
2. Application.ScreenUpdating = False
   
3. [A:K].ClearContents
   
4. Set xD = CreateObject("Scripting.Dictionary")
   
5. Brr = Range([¤u§@ªí1!O65535].End(3), [¤u§@ªí1!O1])
   
6. For X = 1 To UBound(Brr, 1)
   
7.     xD(Brr(X, 1)) = ""
   
8. Next X
   
9. DSC = InputBox("¿é¤J§é¦©%", "§é¦©", "60")
   
10. For E = 1 To Sheets.Count - 1
    
11.     Arr = Sheets(E).UsedRange
    
12.     For X = 2 To UBound(Arr, 1)
    
13.         For Y = 1 To UBound(Arr, 2)
    
14.             If Arr(X, 1) <> "" And Len(Arr(X, Y)) > 7 And xD.exists(Arr(X, Y)) Then
    
15.                 With Sheets("¤u§@ªí1")
    
16.                     K = K + 1: N = ""
    
17.                     Select Case Left(Arr(X, Y), 1)
    
18.                         Case "C"
    
19.                             G = "S220"
    
20.                         Case "M"
    
21.                             G = "M520"
    
22.                         Case "M"
    
23.                             G = "N620"
    
24.                         Case "N"
    
25.                             G = "S220²k±µ"
    
26.                         Case "A"
    
27.                             G = "HSS"
    
28.                         Case "H"
    
29.                             G = "HSS-Co"
    
30.                         Case "S"
    
31.                             G = "SKH"
    
32.                     End Select
    
33.                     xD.Remove (Arr(X, Y))
    
34.                     For S = 1 To 6
    
35.                         If Arr(2, S) <> "" Then N = N & Arr(2, S) & Arr(X, S) & " * "
    
36.                     Next S
    
37.                     Range("A" & K) = K
    
38.                     Range("B" & K) = G
    
39.                     Range("C" & K) = Arr(1, 1) & "-" & Sheets(E).Name & "-" & " " & "²Ä" & X & "¦C" & Chr(10) & Mid(N, 1, Len(N) - 3)
    
40.                     Range("I" & K) = WorksheetFunction.Round(((Arr(X, Y + 1) * DSC) / 100), -1)
    
41.                     Range("J" & K).Formula = "=sum(i" & K & "*h" & K & ")"
    
42.                     Range("K" & K) = Arr(X, Y)
    
43.                 End With
    
44.             End If
    
45.         Next Y
    
46.     Next X
    
47. Next E
    
48. Application.ScreenUpdating = True
    
49. End Sub

½Æ»s¥N½X

0405.rar (141.9 KB)

¤U¸ü¦¸¼Æ: 10

2021-4-5 23:05

agietron

¦^´_ 6# °a¤ªºµ


«D±`·PÁ   °a¤ªºµ¤j¤j¡A
§¹¥þ²Å¦X§Úªº´Á«Ý¡A³t«×¤W¤]§Ö¤F³\¦h¡A
µ{¦¡½Xªº³¡¤À§Ú·|¦n¦nÆp¬ã¡A
­ì¥ý»Ý­n¬ù8¬íªº¤u§@¥Ø«eÁY´î¨ì¬ù¨â¬íÄÁ
«D±`·PÁ±zªº¨ó§U¡C

jcchiang

¦^´_ 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

agietron

¦^´_ 8# jcchiang
«D±`·PÁÂjcchiang¤j¤jªº¨ó§U¡Aµ¹¤F¥t¤@ºØ¤è¦¡¸Ñ¨M°ÝÃD¡A§ó·PÁ¤]¶¶¹DÀ°¦£§â¸óÄæ³£°µ¦n¤F¡C
²{¦b·Q¼W¥[¤@­Ó¥\¯à¡A´N¬O§â"O"Ä椺¤ñ¹ï¤£¦¨¥\ªºÀx¦s®æ¤å¦rÅܦ¨¬õ¦â¡A¸Ó¥[¨º¨Ç»y¥y©O?·Ð½Ð±z§iª¾¡A·PÁ±z¡I

samwang

¦^´_ 9# agietron

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁ¡C

Sub TEST()
Dim Arr, Brr, xD, Frr(1 To 10000, 1 To 11), T, T1, TT, i&, j&, DSC%, sht%, y%, K%
Set xD = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
DSC = InputBox("¿é¤J§é¦©%", "§é¦©", "60")
TM = Timer
Arr = Range([¤u§@ªí1!O1], [¤u§@ªí1!O65535].End(3))
For i = 1 To UBound(Arr)
    xD(Arr(i, 1) & "") = i
    If Right(Arr(i, 1), 1) <> "A" Then
        xD(Arr(i, 1) & "A" & "") = i
    End If
Next

For sht = 1 To Sheets.Count - 1
    Brr = Sheets(sht).UsedRange
    For i = 2 To UBound(Brr)
        For j = 1 To UBound(Brr, 2)
            If xD.Exists(Brr(i, j) & "") Then
                K = K + 1: TT = "": T = Left(Brr(i, j), 1)
                If T = "C" Then
                    T1 = "S220"
                ElseIf T = "M" Then
                    T1 = "M520"
                ElseIf T = "N" Then
                    T1 = "N620"
                ElseIf T = "A" Then
                    T1 = "S220²k±µ"
                ElseIf T = "H" Then
                    T1 = "HSS"
                ElseIf T = "K" Then
                    T1 = "HSS-Co"
                ElseIf T = "S" Then
                    T1 = "SKH"
                End If
                For y = 1 To 6: TT = TT & Brr(2, y) & Brr(i, y) & " * ": Next
                Frr(K, 1) = K
                Frr(K, 2) = T1
                Frr(K, 3) = Brr(1, 1) & "--" & Sheets(sht).Name & " ²Ä" & i - 2 & "¦C" & Chr(10) & Mid(TT, 1, Len(TT) - 3)
                Frr(K, 9) = "=RoundUp((" & (Brr(i, j + 1) & "*" & DSC / 100) & "), -1)"
                Frr(K, 10) = "=sum(i" & K & "*h" & K & ")"
                Frr(K, 11) = Brr(i, j)
                xD.Remove (Brr(i, j))
            End If
        Next
    Next
Next
With Sheets("¤u§@ªí1")
    With Range(.[a1], .[k1].End(4))
        .Value = ""
        .UnMerge
        .Borders.LineStyle = 0
    End With
    With .[a1].Resize(K, 11)
        .Value = Frr
        .Borders.LineStyle = 1
        For i = 1 To K: .Cells(i, 3).Resize(, 5).Merge: Next
    End With
    .Range("o1:o" & UBound(Arr)).Font.Color = RGB(0, 0, 0)
    For i = 1 To UBound(Arr)
        If xD.Exists(Arr(i, 1) & "") Then .Cells(i, 15).Font.Color = RGB(255, 0, 0)
    Next
End With
Application.ScreenUpdating = True
MsgBox "¤w§¹¦¨!  Á`¦@¡G" & Timer - TM & "¬í !"
End Sub