如何动态标记Excel中的列？

Question

我有excel数据如：

   Name                    Assets       Cluster    Flag
  ABN AMRO                 $100,000       2
  Allahabad Bank           $200,000       2
  Allen & Company          $50,000        1 
  Bank of America          $200,000       3 
  Barclays Capital         $300,000       3 
  BB&T                     $70,000        1
  BBY Ltd.                 $150,000       2
  Berkery, Noyes & Co.     $200,000       3
  BG Capital               $90,000        1
  Blackstone               $400,000       3 

等等，大约有2000条记录。

现在我把它们分成了 3 个集群：

Cluster 1: Assets < $100,000
Cluster 2: 100,000 =< Assets < $200,000
Cluster 3: Assets >= 300,000

我想用Excel，基本上做到以下几点：

在每个集群中标记一定的帐户阈值，由用户输入。

例如，用户说只有 5% 的集群 2 应该被标记，所以 excel 函数应该随机将“是”标记到集群 2 中的 5% 的帐户，依此类推。我希望它是交互式的，这就是为什么我希望用户在 excel 的单元格中输入参数，这将随机更改集群中帐户旁边的标志值。 有什么办法可以在 Excel 中实现这一点？

Answer 1

A 列：名称
B 列：资产
C 列：簇
D 列：温度（=排序）
E 列：标志

复制您的工作簿。打开 VBE（使用 Alt F11）并插入一个模块（菜单 -> 插入 -> 模块）。在模块中插入以下代码并执行“main”过程：在 Sub main() 中按 F5

Sub Main()
    'Put the cursor HERE and press F5.

    Application.ScreenUpdating = False
    Dim ActCell As Range
    Set ActCell = ActiveCell

    Call CountTotals
    Call RandomNumber
    Call SortRandom
    Call SetFlag
    ActCell.Select
    Application.ScreenUpdating = True
End Sub

Sub CountTotals()
    Range("H8") = "Cluster"
    Range("H9") = 1
    Range("H10") = 2
    Range("H11") = 3

    Range("I8") = "Flag%"
    If Range("I9") = "" Then Range("I9") = "2%"
    If Range("I10") = "" Then Range("I10") = "5%"
    If Range("I11") = "" Then Range("I11") = "8%"

    Range("J8") = "Count"
    Range("J9:J11").FormulaR1C1 = "=Int(RC[-1]*RC[1])"

    Range("K8") = "Total"
    Range("K9").Formula = "=COUNTIF($C$2:$C$2001,""=1"")"
    Range("K10").Formula = "=COUNTIF($C$2:$C$2001,""=2"")"
    Range("K11").Formula = "=COUNTIF($C$2:$C$2001,""=3"")"
End Sub

Sub RandomNumber()
    Application.Calculation = xlManual
    Range("D2:D2001").Formula = "=int(rand()*1e6)"
    Range("D2:D2001").Copy
    Range("D2:D2001").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

Sub SortRandomOLD()
    ActiveWorkbook.Worksheets("Tabelle2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle2").Sort.SortFields.Add Key:=Range( _
        "C2:C2001"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Tabelle2").Sort.SortFields.Add Key:=Range( _
        "D2:D2001"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle2").Sort
        .SetRange Range("A1:E2001")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub SortRandom()
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "C2:C2001"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "D2:D2001"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1:E2001")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub SetFlag()
    Dim Cluster1Total As Integer
    Dim Cluster2Total As Integer
    Dim Cluster3Total As Integer

    Dim Cluster1Flag As Integer
    Dim Cluster2Flag As Integer
    Dim Cluster3Flag As Integer

    Cluster1Total = Application.WorksheetFunction.CountIf(Range("C2:C2001"), "=1")
    Cluster2Total = Application.WorksheetFunction.CountIf(Range("C2:C2001"), "=2")
    Cluster3Total = Application.WorksheetFunction.CountIf(Range("C2:C2001"), "=3")
    'Debug.Print Cluster1Total

    Cluster1FlagCount = Range("J9").Value
    Cluster2FlagCount = Range("J10").Value
    Cluster3FlagCount = Range("J11").Value

    Range("A1").AutoFilter
    ActiveSheet.Range("$A$1:$E$2001").AutoFilter Field:=3, Criteria1:="1"
    Range("E2:E2001").Formula = "=IF(COUNTIF($C$2:C2,""=1"")<=" & Cluster1FlagCount & ",1,0)"

    ActiveSheet.Range("$A$1:$E$2001").AutoFilter Field:=3, Criteria1:="2"
    Range("E2:E2001").Formula = "=IF(COUNTIF($C$2:C2,""=1"")<=" & Cluster2FlagCount & ",1,0)"

    ActiveSheet.Range("$A$1:$E$2001").AutoFilter Field:=3, Criteria1:="3"
    Range("E2:E2001").Formula = "=IF(COUNTIF($C$2:C2,""=1"")<=" & Cluster3FlagCount & ",1,0)"

    Range("A1").AutoFilter
End Sub