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

¼Ï¯Ã¤ÀªRªí-±Æ§Ç

¼Ï¯Ã¤ÀªRªí-±Æ§Ç

½Ð°Ý¦p¦ó±N¸Óªí®æ¥Î¼Ï¯Ã¤ÀªRªí°µ¦¨¹Ï2¡H

¦~¥÷ = ¥i¥H®Ú¾Ú·½¼Æ¾Úùتº¦~¥÷¿ï¾Ü
¿ï¾Ü¦~¥÷¦Z
·|¥ªÃä«ö·Ó¸Ó¦~¥÷ªºGDPª÷ÃB¦Û°Ê±Æ§ÇÀY10­Ó¡C
µM«á¥kÃä®Ú¾Ú¥ªÃ䪺ªí®æ¦Û°Ê¥Í¦¨´Î§Î¹Ï

2.jpg (386.91 KB)

2.jpg

2.zip (16.12 KB)

¼Ï¯Ã¤ÀªRªí´X¥G¨S¥Î¨ì, ½Æ»s¦A±Æ§Ç§Y¥i
Xl0000096.rar (19.64 KB)

TOP

¼Ï¯Ã¤ÀªRªí´X¥G¨S¥Î¨ì, ½Æ»s¦A±Æ§Ç§Y¥i
­ã´£³¡ªL µoªí©ó 2023-11-5 14:54


½Ð°Ý¦³¨S¦³¤ñ¸û²³æªº¤èªk¨Óªí¹F¥Xµ²ªG¡H
¥t¥~¦³¨S¦³¥\¯à¬O·íREPORT ùØ­±ªº"B1" ¦~¥÷§ó§ï¦Z¡A¦Û°Ê¹B¦æVBA, ¤£¥Î¦A¥h«öRUN?

Sub Report()
Dim I As Integer, Last As Integer
Dim Frng As Range, Rng As Range
    Sheets("Data").Select
    Columns("N:CE").Select
    Selection.ClearContents
  
   
    Sheets("Data").Select
    Range("A1:L50").Select
    Selection.Copy
    Sheets("Data").Select
    Range("N2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
         With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Sheets("Data").Select
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Columns("E:E").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Report").Select
    Range("F2").Select
    Application.CutCopyMode = False
   
    Last = Sheets("Report").Range("E1").CurrentRegion.Rows.Count
   
    For I = 2 To Last
   
Sheets("Report").Range("F" & I).Value = Application.VLookup(Range("B1"), Sheets("Data").Range("N:CC"), I, False)
    Next I
     Columns("E:F").Select
    ActiveWorkbook.Worksheets("Report").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Report").Sort.SortFields.Add2 Key:=Range("F2:F52") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Report").Sort
        .SetRange Range("E1:F52")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("E12:F500").Select
    Selection.ClearContents
    Range("B1").Select
        
End Sub

图ªí·½数ÕuVBA动态图.rar (40.86 KB)

TOP

¼Ï¯Ã¤ÀªRªí´X¥G¨S¥Î¨ì, ½Æ»s¦A±Æ§Ç§Y¥i
­ã´£³¡ªL µoªí©ó 2023-11-5 14:54



·PÁ¡A½Ð°Ý¯à¤£¯à®Ú¾Ú¦~¥÷¦b¹Ïªí¤W¥[´¡¦~¥÷¡H¦pªþ¹Ï
¥t¥~¥i§_¿é¤J¦~¥÷¦Z¡A¦Û¤v¹B¦æVBA?

1.jpg (386.91 KB)

1.jpg

TOP

¦^´_ 1# 198188
¦^´_ 2# ­ã´£³¡ªL


    ÁÂÁ 198188«e½úµoªí¦¹¥DÃD»P½d¨Ò,ÁÂÁ ­ã´£³¡ªL«e½ú«ü¾É
«á¾Ç¾Ç²ß¤ß±o¦p¤U,½Ð«e½ú¦A«ü¾É

²M°£Â¸ê®Æ:


°õ¦æµ²ªG:



Sub Test_A1()
Dim R&, C
'¡ô«Å§iÅܼÆ:R¬Oªø¾ã¼Æ,C¬O³q¥Î«¬ÅܼÆ
C = Application.Match([c1], Sheet1.[1:1], 0)
'¡ô¥OC³o³q¥Î«¬ÅܼƬO ¥HMatch()¤èªk¦^¶Ç[C1]Àx¦s®æ­È ¦bSheet1(·½¼ÆÕu)ªí.[1:1]ªº¦ì¸m
https://learn.microsoft.com/zh-t ... sheetfunction.match
If IsError(C) Then Exit Sub
'¡ô¦pªG¥HIsError ¨ç¼Æ§PÂ_ CÅܼƦ^¶Ç(TRUE):¬O¿ù»~­È,´Nµ²§ôµ{¦¡°õ¦æ
R = Sheet1.[a65536].End(3).Row - 1
'¡ô¥OR³oªø¾ã¼ÆÅܼƬO Sheet1(·½¼ÆÕu)AÄæ³Ì«á¤@­Ó¦³¤º®eÀx¦s®æ¦C¸¹-1
With [c4].Resize(R, 2)
'¡ô¥H¤U¬OÃö©ó [C4]Àx¦s®æÂX®i¦V¤URÅܼƦC,ÂX®i¦V¥k2Äæ½d³òÀx¦s®æªºµ{§Ç
     .Columns(1) = Sheet1.[a2].Resize(R).Value
     '¡ô¥O¸Ó½d³òÀx¦s®æ²Ä1ÄæÀx¦s®æ­È¬O Sheet1(·½¼ÆÕu)ªí.[A2]ÂX®i¦V¤URÅܼƦCÀx¦s®æ­È
     .Columns(2) = Sheet1.Cells(2, C).Resize(R).Value
     '¡ô¥O¸Ó½d³òÀx¦s®æ²Ä2ÄæÀx¦s®æ­È¬O Sheet1(·½¼ÆÕu)ªí²Ä CÅܼÆÄæ/²Ä2¦CÀx¦s®æ,
     '¦V¤URÅܼƦCÀx¦s®æ­È

     .Sort Key1:=.Item(2), Order1:=xlDescending, Header:=xlNo
     '¡ô¥O¸Ó½d³ò¥H²Ä2Äæ°µ¨S¦³¼ÐÃDªºº¥´î±Æ§Ç
     .Rows(11).Resize(R).ClearContents
     '¡ô¥O¸Ó°Ï°ì²Ä11¦C¶}©lÂX®i¦V¤URÅܼƦCªº½d³òÀx¦s®æ¤º®e²M°£
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-11-6 08:40 ½s¿è

¦^´_ 4# 198188


    «á¾Ç«Øij¥H¤U¤èªk
1.¦b¹Ïªí´¡¤J¤å¦r¤è¶ô,´¡¤J¨ç¼Æ =$C$1 §@¬°¤å¦r¤è¶ô¤º®e
2.IJµo[C1]Àx¦s®æ®É¦Û°Ê°õ¦æµ{¦¡½X

1.


2.



Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "C1" Then Call Test_A1
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 5# Andy2483


    ·PÁ«e½ú«ü¾É¸Ñ´b

TOP

¦^´_ 8# 198188


       Sub test()
Set cn = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
cn.Open V & "Data Source=" & ThisWorkbook.FullName
q = "select top 10 " & Sheet1.[A1] & ", [" & Sheet2.[C1] & "] from [" & Sheet1.Name & "$A1:L]"
q = q & " order by [" & Sheet2.[C1] & "] desc"
Sheet2.[C4].CopyFromRecordset cn.Execute(q)
End Sub
Xl0000096.zip (22 Bytes)

TOP

¦^´_ 9# singo1232001


    ÁÂÁ¡I¤£¹Lªþ¥óªºÀ£ÁYÀÉùجOªÅªº

TOP

Xl0000096.zip (25.51 KB) ¦^´_ 10# 198188


    ¸É¶Ç

TOP

        ÀR«ä¦Û¦b : §Ú­Ì³Ì¤jªº¼Ä¤H¤£¬O§O¤H¡D¥i¯à¬O¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD