ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] «ü©w¸¹½X¦b°¸¼ÆÄ檺Á`­Ó¼Æ¤Î©_¼ÆÄ檺Á`¦¸¼Æ

¦^´_ 9# ziv976688

½Ð¦Û¦æ·s¼W¦p¤U¡A¦]¬°·íµL¸ê®Æ¸É¤W0¡AÁÂÁÂ
   
For i = 2 To UBound(Arr)
      For j = 1 To 2: Arr(i - 1, j) = xD(Arr(i, 1) & "/" & j): Next
      If xD(Arr(i, 1) & "/1") = "" Then Arr(i - 1, 1) = 0: Arr(i - 1, 2) = 0 '­n·s¼W
Next
  .[C2].Resize(UBound(Arr) - 1, 2) = Arr  'C&DÄæ
Â^¨ú.PNG

TOP

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-8-22 10:40 ½s¿è

¦^´_ 10# samwang
·PÁ±zªº«ü¾É^^

¥¼©R¦W.png
2021-8-22 10:23

TEST_0822_s1.rar (24.92 KB)
¤£¦n·N«ä¡A"·s¼W»Ý¨D"ªºµ{¦¡½X~§Ú©ñ¸mªº¦ì¦C~¤£ª¾¹D¬O­þ¸Ì¦³»~¸m?
©Ò¥H¦b¦C47·|²£¥Í°»¿ù^^"
If Arr(i, 3) > 0 Then Arr(i, 4) = Arr(i, 3) / Arr(i, 2)
©|½Ð³Ò¾r±z½ç¥¿¡CÁÂÁ±z!

Private Sub CommandButton1_Click()
Dim Arr, Brr(1 To 7), Crr, xD, T%, i&, j&
    Nrange = "1878" ' InputBox("½Ð¿é¤JDATA!ªº¶}¼ú´Á¼Æ", "¿é¤J´Á¼Æ")
    Tm = Timer
    [L1] = ""
    Application.DisplayAlerts = False
   
    Set xD = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
        .[A1] = Nrange
        T = .[A1]
        Arr = Range([DATA!h1], [DATA!a65536].End(3))
        For i = 2 To UBound(Arr)
         If Arr(i, 1) = T Then
          For j = 2 To 8: n = n + 1: Brr(n) = Arr(i, j): Next
         End If
        Next

       .[A2] = ((.Cells(1, 256).End(xlToLeft).Column - 12) / 2) & "­Ó"
       .[A3] = "¶}¼ú¸¹½X"
       .[A4].Resize(7) = Application.Transpose(Brr)


          For i = 1 To 49   'BÄæ
          .Range("B" & i + 1) = i
          Next
  
        R = .Columns("M:DF").Find("*", , , , , 2).Row
        Arr = .Range("M1:DF" & R)
      For j = 1 To UBound(Arr, 2) Step 2
       For i = 2 To UBound(Arr)
        T = Arr(i, j): If T = 0 Then GoTo 98
        xD(T & "/1") = xD(T & "/1") + 1
        xD(T & "/2") = xD(T & "/2") + Arr(i, j + 1)
       Next i
98:   Next j
       Arr = .Range(.[C1], .[B65536].End(3))
     For i = 2 To UBound(Arr)
      For j = 1 To 2: Arr(i - 1, j) = xD(Arr(i, 1) & "/" & j): Next
      If xD(Arr(i, 1) & "/1") = "" Then Arr(i - 1, 1) = 0: Arr(i - 1, 2) = 0 '­n·s¼W
     Next
     .[C2].Resize(UBound(Arr) - 1, 2) = Arr  'C&DÄæ

Arr = .Range(.[B2], .[e65536].End(3))
ReDim Crr(1 To UBound(Arr), 1 To 5)
For i = 1 To UBound(Arr)
    If Arr(i, 3) > 0 Then Arr(i, 4) = Arr(i, 3) / Arr(i, 2)
    Crr(i, 1) = Arr(i, 2): Crr(i, 2) = Arr(i, 2)
    Crr(i, 3) = Arr(i, 1): Crr(i, 4) = Arr(i, 3)
    Crr(i, 5) = Arr(i, 4)
Next
.[B2].Resize(UBound(Arr), 4) = Arr
With .Range("g2").Resize(UBound(Crr), 5)
    .Value = Crr
    .Sort key1:=.Item(1), Order1:=2, Header:=xlNo
    Crr = .Value
End With
T = Application.Max(.Range("g2:g" & UBound(Crr)))
For i = 1 To UBound(Crr)
    Crr(i, 1) = T - Crr(i, 1) + 1
Next
.[H2].Resize(UBound(Crr), 1) = Crr


'ª©­±®æ¦¡.........................................................
            With .Columns("A:DF")
                .Font.Name = "Verdana"  '¦rÅé
                .HorizontalAlignment = xlCenter  '¥ª¥k¸m¤¤
                .VerticalAlignment = xlCenter  '¤W¤U¸m¤¤
                .EntireColumn.AutoFit  '¦Û°ÊÄæ¼e
                .EntireRow.AutoFit  '¦Û°Ê¦C°ª
            End With
    End With




        Sheets("Sheet1").Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\7C_0_" & Nrange & "´Á_" & Sheets("Sheet1").[A2] & ".xls"
        ActiveWindow.Close
    Application.Goto [DATA!J1]
[L1] = Nrange & "=" & Format((Timer - Tm) / 24 / 60 / 60, "hh:mm:ss")
End Sub

TOP

¦^´_  samwang
·PÁ±zªº«ü¾É^^



¤£¦n·N«ä¡A"·s¼W»Ý¨D"ªºµ{¦¡½X~§Ú©ñ¸mªº¦ì¦C~¤£ª¾¹D¬O­þ¸Ì¦³»~¸m ...
ziv976688 µoªí©ó 2021-8-22 10:28



¤£¦n·N«ä¡AArr¨Ó·½ªº¸ê®Æb¡Be­n¹ï½Õ¤@¤U§Y¥i¡AÁÂÁÂ
Arr = .Range(.[e2], .[b65536].End(3))

TOP

¦^´_ 13# samwang
OK¤F
ÁÂÁ±z¦h¦¸ªº¼ö¤ßÀ°¦£©M«ü¾É~·P®¦

TOP

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-8-22 14:34 ½s¿è

¦^´_ 13# samwang
¤£¦n·N«ä~Àµ½Ð±z¦A«ü¾É¨ú¥Nªº»yªk¡G
±NM:V = A4:A9¥B¬°7¸¹¦rÃCªº¼Æ¦r~¼Ð¥Ü4¸¹©³¦â
±NM:V = A10¥B¬°7¸¹¦rÃCªº¼Æ¦r~¼Ð¥Ü8¸¹©³¦â
ÁÂÁ±z¡I
¥¼©R¦W.png
2021-8-22 14:30

Book1.rar (4.04 KB)

TOP

¦^´_ 15# ziv976688

Àx¦s®æ¤ÏÃC¦â¦p¤U¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub test()
Dim Arr, Brr
With Sheets("Sheet1")
    Arr = .[a1:a10]
    R = .Columns("M:V").Find("*", , , , , 2).Row
    Brr = .Range("M1:DF" & R)
    For i = 4 To UBound(Arr)
        If i < UBound(Arr) Then
            .Cells(i, 1).Interior.Color = 65280
            For j = 1 To UBound(Brr, 2) Step 2
            For i2 = 2 To UBound(Brr)
                If Brr(i2, j) = Arr(i, 1) Then
                .Cells(i2, j + 12).Interior.Color = 65280
                End If
            Next i2
            Next j
        Else
            .Cells(i, 1).Interior.Color = 16776960
            For j = 1 To UBound(Brr, 2) Step 2
            For i2 = 2 To UBound(Brr)
                If Brr(i2, j) = Arr(i, 1) Then
                .Cells(i2, j + 12).Interior.Color = 16776960
                End If
            Next i2
            Next j
        End If
    Next
End With
End Sub

TOP

¦^´_ 16# samwang
§¹¥þOK¤F!
·PÁ±z

TOP

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-8-23 00:44 ½s¿è

¦^´_ 16# samwang
S¤j¤j : ±z¦n !
¤£¦n·N«ä¡A¯à§_½Ð±z¥t¥~¦A«ü¾É~¥H´M§ä¡÷¨ú¥Nªº¤è¦¡¨Ó§¹¦¨»Ý¨D?
EX1¡G½d³ò = .Columns("B:DF")¡A´M§ä = .[A4:A9] ¥B¦rÅéÃC¦â=7¸¹ªº¼Æ¦r¡A¨ú¥N¬°4¸¹©³¦â¡C
EX2¡G½d³ò = .Columns("B:DF")¡A´M§ä = .[A10] ¥B¦rÅéÃC¦â=7¸¹ªº¼Æ¦r¡A¨ú¥N¬°8¸¹©³¦â¡C
®¤¤p§Ì²Â©å~·í¼Ð¥Üªº½d³ò§ïÅܮɡA­ìµ{¦¡½Xªº¦UÃöÁä¼Æ¦r~§ÚµLªk½Õ¾ã¨ì§¹¥þ²Å¦X(Á`¦³½Ä¬ð)»Ý¨Dªº¼Æ¦r¡C
ÁÂÁ±z¡I

======================================
¦p¤U¦C¿ý»s¥H´M§ä©M¨ú¥Nªº¤è¦¡¤§µ{¦¡½X :  
With Sheets("Sheet1")
.Columns("B:DF").Select
    With Application.FindFormat.Font
        .FontStyle = "²ÊÅé"
        .Subscript = False
        .ColorIndex = 7
    End With
    Application.ReplaceFormat.Interior.ColorIndex = 8
    Selection.Replace What:=.[A10], Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
        ReplaceFormat:=True
End With

TOP

¦^´_  samwang
S¤j¤j : ±z¦n !
¤£¦n·N«ä¡A¯à§_½Ð±z¥t¥~¦A«ü¾É~¥H´M§ä¡÷¨ú¥Nªº¤è¦¡¨Ó§¹¦¨»Ý¨D?
EX1¡G½d³ò ...
ziv976688 µoªí©ó 2021-8-23 00:15


¤£¤Ó¯à²z¸Ñ±zªº·N«ä¡A
´M§ä = .[A4:A9] ¥B¦rÅéÃC¦â=7¸¹ªº¼Æ¦r¡A¨ú¥N¬°4¸¹©³¦â >> ³o¬O¤£¬O©M#16µ{¦¡»Ý¨D¤@¼Ë¶Ü?

TOP

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-8-23 07:41 ½s¿è

¦^´_ 19# samwang
¤£¤Ó¯à²z¸Ñ±zªº·N«ä¡A
´M§ä = .[A4:A9] ¥B¦rÅéÃC¦â=7¸¹ªº¼Æ¦r¡A¨ú¥N¬°4¸¹©³¦â >> ³o¬O¤£¬O©M#16µ{¦¡»Ý¨D¤@¼Ë¶Ü?

¬Oªº!  ÁÂÁ±z
-----------------
¤£¦n·N«ä~
§Ú¥u·|³Ì°ò¥»ªº If..... Then......End If  ªº»yªk
EX :³o­Ó»Ý¨D¡A§Ú¥u·|~
Sub test()
Dim i%, j%, k%

With Sheets("Sheet1")
For i = 4 To 9
  For j = 2 To 50
    For k = 2 To 110
    If Cells(j, k).Font.ColorIndex = 7 Then
     If (Cells(j, k) = Cells(i, 1)) Then
      Cells(j, k).Interior.ColorIndex = 4
     End If
     If (Cells(j, k) = Cells(10, 1)) Then
      Cells(j, k).Interior.ColorIndex = 8
     End If
    End If
Next k
Next j
  Next i
End With
End Sub

¦]¬°«Ü·Q¾Ç²ß¶Q»yªk¡A©Ò¥H¤~«_¬N¤@ÃD³Ò·Ð±z³o»ò¦h¦¸~©|½Ð¨£½Ì
ÁÂÁ±z

TOP

        ÀR«ä¦Û¦b : µÊ®ð¼L¤Ú¤£¦n¡A¤ß¦a¦A¦n¤]¤£¯àºâ¬O¦n¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD