VBA pºâ¼Æ¾Ú¥X²{¦¸¼Æ¨Ã±Æ§Ç
- ©«¤l
- 97
- ¥DÃD
- 33
- ºëµØ
- 0
- ¿n¤À
- 129
- ÂI¦W
- 0
- §@·~¨t²Î
- Win 7
- ³nÅ骩¥»
- office 2007
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2019-5-7
- ³Ì«áµn¿ý
- 2022-8-25
|
VBA pºâ¼Æ¾Ú¥X²{¦¸¼Æ¨Ã±Æ§Ç
¥»©«³Ì«á¥Ñ s13030029 ©ó 2019-8-9 16:34 ½s¿è
Q1¡G½Ð°Ýn¦p¦ó¤£Åã¥Ü©ÎpºâªÅ¥ÕªºÀx¦s®æ??
Q2¡G½Ð°Ýn¦p¦ó¤£Åã¥Ü¦¸¼Æ¤p©ó1ªºÀx¦s®æ??
- Sub «ö¥X²{¦¸¼Æ±Æ§Ç()
- Dim d As Object
- Dim Arr
- Dim i As Integer, j As Integer
- Application.ScreenUpdating = False
- Range("A15:B30").Clear
- '´£¨ú¤£«½ÆÈ¨Öpºâ¥X²{¦¸¼Æ
- Set d = CreateObject("Scripting.Dictionary")
- Arr = Range("A2:H6")
- For i = 1 To UBound(Arr, 1) 'pºâ°}¦C¤j¤p(¦C)
- For j = 1 To UBound(Arr, 2) 'pºâ°}¦C¤j¤p(Äæ)
- If Not d.Exists(Arr(i, j)) Then
- d.Add Arr(i, j), 1
- Else
- d.Item(Arr(i, j)) = d.Item(Arr(i, j)) + 1
- End If
- Next
- Next
-
- '¿é¥X¨Ã±Æ§Ç
- Range("A15").Resize(d.Count) = Application.Transpose(d.keys)
- Range("B15").Resize(d.Count) = Application.Transpose(d.items)
- Range("A15:B15").Resize(d.Count).Sort key1:=Range("B14"), Order1:=xlDescending
-
- Set d = Nothing
- Application.ScreenUpdating = True
- End Sub
½Æ»s¥N½X
test.rar (20.2 KB)
|
|
|
|
|
|
|
- ©«¤l
- 2728
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2784
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2023-11-28
|
Sub «ö¥X²{¦¸¼Æ±Æ§Ç()
Dim Arr, A, xD, Brr(1 To 20000, 1 To 2), N&
Range("A15:B30").Clear
Arr = Range("A2:H6")
Set xD = CreateObject("Scripting.Dictionary")
For Each A In Arr
If A = "" Then GoTo 101
xD(A) = xD(A) + 1
If xD(A) = 2 Then N = N + 1: xD(A & "S") = N: Brr(N, 1) = A
If xD(A) > 1 Then Brr(xD(A & "S"), 2) = xD(A)
101: Next
With [A15:B15].Resize(N)
.Value = Brr
.Sort Key1:=.Item(2), Order1:=xlDescending, _
Key2:=.Item(1), Order2:=xlDescending, Header:=xlNo
End With
End Sub
========================================== |
|
|
|
|
|
|
- ©«¤l
- 97
- ¥DÃD
- 33
- ºëµØ
- 0
- ¿n¤À
- 129
- ÂI¦W
- 0
- §@·~¨t²Î
- Win 7
- ³nÅ骩¥»
- office 2007
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2019-5-7
- ³Ì«áµn¿ý
- 2022-8-25
|
¦^´_ 2# ã´£³¡ªL
¨º¦pªG»¡§Úªº¼Æ¾Ú¥i¯à¨S¦³¥þ³¡¿é¤J§¹¡A¦ý¬O¨Cµ§¥X²{ªº¦¸¼Æ³£¥u¦³¤@¦¸
³o¬qµ{¦¡½X´N·|¥X²{¿ù»~¡A³on«ç»ò§ï?
With [G1:H1].Resize(N)
.Value = Brr
.Sort Key1:=.Item(2), Order1:=xlDescending, _
Key2:=.Item(1), Order2:=xlDescending, Header:=xlNo
End With |
|
|
|
|
|
|
- ©«¤l
- 2728
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2784
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2023-11-28
|
¦^´_ 3# s13030029
IF N=0 THEN EXIT SUB '¥[³o¤@¦æ
With [A15:B15].Resize(N)
.Value = Brr
.Sort Key1:=.Item(2), Order1:=xlDescending, _
Key2:=.Item(1), Order2:=xlDescending, Header:=xlNo
End With |
|
|
|
|
|
|
- ©«¤l
- 97
- ¥DÃD
- 33
- ºëµØ
- 0
- ¿n¤À
- 129
- ÂI¦W
- 0
- §@·~¨t²Î
- Win 7
- ³nÅ骩¥»
- office 2007
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2019-5-7
- ³Ì«áµn¿ý
- 2022-8-25
|
¦^´_ 4# ã´£³¡ªL
ì¨Ó¦p¦¹~ÁÂÁÂã¤j~~ |
|
|
|
|
|
|
- ©«¤l
- 97
- ¥DÃD
- 33
- ºëµØ
- 0
- ¿n¤À
- 129
- ÂI¦W
- 0
- §@·~¨t²Î
- Win 7
- ³nÅ骩¥»
- office 2007
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2019-5-7
- ³Ì«áµn¿ý
- 2022-8-25
|
¥»©«³Ì«á¥Ñ s13030029 ©ó 2019-8-14 10:44 ½s¿è
¦^´_ 2# ã´£³¡ªL
ã¤j~
§Ú·Q¦A½Ð°Ý¤@¤U¡A¦pªGn¦A§ä¥X³Ì¤jÈ©M³Ì¤pÈ¡A¨Ã¥Î.Interior.Color ¼Ð°O¦¨¬õ¦âªº¸Ü¡An«ç»ò§ï???
(¥X²{¦¸¼Æµ¥©ó1ªº³¡¤À¥i¯àÁÙ¬OnÅã¥Ü¥X¨Ó)
test.rar (27.38 KB)
- Sub «ö¥X²{¦¸¼Æ±Æ§Ç()
- Application.ScreenUpdating = False
- Dim Arr, a, xD, Brr(1 To 20000, 1 To 2), N&
- ThisWorkbook.Sheets("¶q´ú").Range("H2:I" & Range("H" & Rows.Count).End(xlDown).Row).Clear
- Arr = Range("B2:F31")
- Set xD = CreateObject("Scripting.Dictionary")
- If ThisWorkbook.Sheets("¶q´ú").[B2] = "" Then Exit Sub
- For Each a In Arr
- If a = "" Then GoTo 101
- xD(a) = xD(a) + 1
- If xD(a) = 1 Then N = N + 1: xD(a & "S") = N: Brr(N, 1) = a
- If xD(a) > 1 Then Brr(xD(a & "S"), 2) = xD(a)
- 101: Next
- If N = 0 Then Exit Sub
- With ThisWorkbook.Sheets("¶q´ú").[H2:I2].Resize(N)
- .Value = Brr
- .Sort Key1:=.Item(2), Order1:=xlDescending, _
- Key2:=.Item(1), Order2:=xlDescending, Header:=xlNo
- End With
- With ThisWorkbook.Sheets("¶q´ú").Range("H1:I" & Range("H" & Rows.Count).End(xlUp).Row)
- .NumberFormatLocal = "0.00_ "
- .HorizontalAlignment = xlCenter
- .VerticalAlignment = xlCenter
- .Borders(xlEdgeLeft).LineStyle = xlContinuous
- .Borders(xlEdgeTop).LineStyle = xlContinuous
- .Borders(xlEdgeBottom).LineStyle = xlContinuous
- .Borders(xlEdgeRight).LineStyle = xlContinuous
- .Borders(xlInsideVertical).LineStyle = xlContinuous
- .Borders(xlInsideHorizontal).LineStyle = xlContinuous
- End With
- With ThisWorkbook.Sheets("¶q´ú").Range("I1:I11")
- .NumberFormatLocal = "0"
- End With
- For x = 2 To 6
- For Y = 2 To 31
- Cells(Y, x).Interior.Color = xlNone
- If Cells(Y, x).Value = Cells(2, "H").Value And Cells(2, "H") <> "" Then
- Cells(Y, x).Interior.Color = RGB(252, 216, 162)
- Cells(2, "H").Interior.Color = RGB(252, 216, 162)
- End If
- If Cells(Y, x).Value = Cells(3, "H").Value And Cells(3, "H") <> "" Then
- Cells(Y, x).Interior.Color = RGB(144, 248, 169)
- Cells(3, "H").Interior.Color = RGB(144, 248, 169)
- End If
- If Cells(Y, x).Value = Cells(4, "H").Value And Cells(4, "H") <> "" Then
- Cells(Y, x).Interior.Color = RGB(170, 250, 252)
- Cells(4, "H").Interior.Color = RGB(170, 250, 252)
- End If
- Next Y
- Next x
- Application.ScreenUpdating = True
- End Sub
- '=================================
- Sub ²M°£()
- ThisWorkbook.Sheets("¶q´ú").Range("B2:F31").ClearContents
- With ThisWorkbook.Sheets("¶q´ú").Range("B2:F31")
- .NumberFormatLocal = "0.00_ "
- .Borders(xlEdgeLeft).LineStyle = xlContinuous
- .Borders(xlEdgeTop).LineStyle = xlContinuous
- .Borders(xlEdgeBottom).LineStyle = xlContinuous
- .Borders(xlEdgeRight).LineStyle = xlContinuous
- .Borders(xlInsideVertical).LineStyle = xlContinuous
- .Borders(xlInsideHorizontal).LineStyle = xlContinuous
- .Interior.Color = xlNone
- End With
- Range("B2").Select
- End Sub
½Æ»s¥N½X |
|
|
|
|
|
|
- ©«¤l
- 1327
- ¥DÃD
- 4
- ºëµØ
- 0
- ¿n¤À
- 1337
- ÂI¦W
- 0
- §@·~¨t²Î
- WIN
- ³nÅ骩¥»
- 2007
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2015-9-11
- ³Ì«áµn¿ý
- 2023-11-28

|
|
ÀH·NºÛ "EXCEL°g" blog ©Îhttps://hcm19522.blogspot.com/ EXCEL¨ç¼Æ
|
|
|
|
|