Question

所有Excel / VBA专家，

需要您的帮助才能制作一个从列中计算城市平均数的宏。在下面我有一个宏，可以计算给定数组中的城市数量。需要将城市的平均数量放在名称旁边。谢谢你的帮助。

Public Sub CountA()

Dim wb As Workbook
Dim ws As Worksheet
Dim lastCell As String
Dim countRange As Range

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet 'Change as appropriate

Set countRange = ws.Range(Cells(2, "V"), Cells(ws.Range("V2").End(xlDown).Row, "V"))

Debug.Print countRange.Address

Dim Cities()
Cities = Array("Auckland", "Brisbane", "Melbourne", "Seoul", "Tokyo", "Sydney", "Bratislava", "Bangalore", "Chennai", "Gurgaon", "Hyderabad", "Kolkata", "New Delhi", "Noida", "Mumbai", "London", "Munich", "Unterfohring", "Aachen", "Abidjan", "Abington", "Alpharetta", "Amstelveen", "Amsterdam", "Anaheim", "Aquascalientes", "Arlon", "Ashland", "Atlanta", "Aurora", "Austin", "Barcelona", "Basel", "Batavia", "Bay Village", "Belton", "Berkshire", "Berlin", "Birmingham", "Bogota", "Boise", "Boston", "Bramley", "Brandon", "Brecksville", "Brentwood", "Bridgetown", "Brussels", "Budapest", "Buffalo Grove", "Bury", "Cairo", "Callahan", "Calumet City", "Cape Town", "Capitola", "Cardiff", "Carmel", "Centennial", "Chanhassen", "Charlotte", "Cheltenham", "Cincinnati", "Clearwater", "Clemson", "Cleveland", "Cohoes", "Columbia", "Columbus", "Conifer", "Cookeville", "Copenhagen", "Coral Gables", "Croydon", "Culver City", "Cumming", "Cutchogue", "Dallas", "Dallas Park", "Darmstadt", "Double Oak", "Dublin")

Dim city As Long
Dim counter As Long
Dim startRange As Range
Set startRange = ws.Cells(ws.Range("V2").End(xlDown).Row, "V").Offset(2, 0)

counter = 2

For city = LBound(Cities) To UBound(Cities)
    Debug.Print Cities(x)
  If Application.WorksheetFunction.CountIf(countRange, Cities(city)) > 0 Then
    startRange.Offset(counter, 0) = Application.WorksheetFunction.CountIf(countRange, Cities(city))
    startRange.Offset(counter, 1) = Cities(city)
     counter = counter + 1

  End If

Next city


End Sub

试过这个：

For city = LBound(Cities) To UBound(Cities) 
    Debug.Print Cities(x) 
    If Application.WorksheetFunction.AverageIf(countRange, Cities(city)) > 0 Then 
        startRange.Offset(counter, 0) = Application.WorksheetFunction.AverageIf(countRange, Cities(city)) 
        startRange.Offset(counter, 1) = Cities(city)

目前我的代码可以计算如果城市以蓝色突出显示，并显示其下面的结果以红色突出显示并以黄色突出显示。我的目标是添加另一个数据，即绿色突出显示的城市百分比。我可以通过做例如 = COUNTIF（V2：V25，“Bratislava”）/ COUNTA（V2：V5）手动完成。但正如你在我的阵列上看到的那样，我需要在每个城市手动输入所有内容。感谢您的专家帮助。

Answer 1

您需要添加几行。

获取城市总数：

Dim citiesCount As Long
citiesCount = countRange.Rows.Count

写出每个城市的城市总数比例：

startRange.Offset(counter, -1) = Application.WorksheetFunction.CountIf(countRange, Cities(city)) / citiesCount

我强烈建议您使用Tim的建议，即从工作表中阅读城市，而不是全部输入。

如果第V列中没有任何内容，我还建议进行错误处理。

使用额外的行：

Option Explicit

Public Sub CountA()

Dim wb As Workbook
Dim ws As Worksheet
Dim lastCell As String
Dim countRange As Range

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet 'Change as appropriate

Set countRange = ws.Range(Cells(2, "V"), Cells(ws.Range("V2").End(xlDown).Row, "V"))

Dim Cities()
Cities = Array("Auckland", "Brisbane", "Melbourne", "Seoul", "Tokyo", "Sydney", "Bratislava", "Bangalore", "Chennai", "Gurgaon", "Hyderabad", "Kolkata", "New Delhi", "Noida", "Mumbai", "London", "Munich", "Unterfohring", "Aachen", "Abidjan", "Abington", "Alpharetta", "Amstelveen", "Amsterdam", "Anaheim", "Aquascalientes", "Arlon", "Ashland", "Atlanta", "Aurora", "Austin", "Barcelona", "Basel", "Batavia", "Bay Village", "Belton", "Berkshire", "Berlin", "Birmingham", "Bogota", "Boise", "Boston", "Bramley", "Brandon", "Brecksville", "Brentwood", "Bridgetown", "Brussels", "Budapest", "Buffalo Grove", "Bury", "Cairo", "Callahan", "Calumet City", "Cape Town", "Capitola", "Cardiff", "Carmel", "Centennial", "Chanhassen", "Charlotte", "Cheltenham", "Cincinnati", "Clearwater", "Clemson", "Cleveland", "Cohoes", "Columbia", "Columbus", "Conifer", "Cookeville", "Copenhagen", "Coral Gables", "Croydon", "Culver City", "Cumming", "Cutchogue", "Dallas", "Dallas Park", "Darmstadt", "Double Oak", "Dublin")

Dim city As Long
Dim counter As Long
Dim startRange As Range

Set startRange = ws.Cells(ws.Range("V2").End(xlDown).Row, "V").Offset(2, 0)

counter = 2

Dim citiesCount As Long
citiesCount = countRange.Rows.Count 'new line to hold total number of cities

For city = LBound(Cities) To UBound(Cities)

  If Application.WorksheetFunction.CountIf(countRange, Cities(city)) > 0 Then
    startRange.Offset(counter, -1) = Application.WorksheetFunction.CountIf(countRange, Cities(city)) / citiesCount 'new line to calculate proportion of total
    startRange.Offset(counter, 0) = Application.WorksheetFunction.CountIf(countRange, Cities(city))
    startRange.Offset(counter, 1) = Cities(city)
     counter = counter + 1

  End If

Next city

End Sub

这是一个版本2，从名为CitiesList的工作表中读取城市列表，确保您处于正确的工作表中，并对空计数范围进行一些错误处理。

Option Explicit

Public Sub CountA()

    Dim wb As Workbook
    Dim ws As Worksheet
  ' Dim lastCell As String ''not used
    Dim countRange As Range

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")             'Change as appropriate

    Set countRange = ws.Range(ws.Cells(2, "V"), ws.Cells(ws.Range("V2").End(xlDown).Row, "V"))

    Dim Cities()
    Cities = GetCities                           'Call function to populate array with cities from worksheet

    Dim city As Long
    Dim counter As Long
    Dim startRange As Range

    On Error Resume Next 'Error handling for range being empty. Might not be the best error handling.
    Set startRange = ws.Cells(ws.Range("V2").End(xlDown).Row, "V").Offset(2, 0)
    On Error GoTo 0

    If startRange Is Nothing Then
       Exit Sub
    Else
       Resume
    End If

    counter = 2

    Dim citiesCount As Long
    citiesCount = countRange.Rows.Count

    With ws                                      'make sure in right sheet

        For city = LBound(Cities, 1) To UBound(Cities, 1)

            If Application.WorksheetFunction.CountIf(countRange, Cities(city, 1)) > 0 Then
                startRange.Offset(counter, -1) = Application.WorksheetFunction.CountIf(countRange, Cities(city, 1)) / citiesCount
                startRange.Offset(counter, 0) = Application.WorksheetFunction.CountIf(countRange, Cities(city, 1))
                startRange.Offset(counter, 1) = Cities(city, 1)
                counter = counter + 1

            End If

        Next city

    End With

End Sub

Public Function GetCities() As Variant
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Worksheets("CitiesList")
    GetCities = ws.Range("B2", ws.Range("B2").End(xlDown)) ' Amend as appropriate

End Function

Answer 2

已编译但未经过测试：

Public Sub CountA()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lastCell As String
    Dim countRange As Range

    Set wb = ThisWorkbook
    Set ws = wb.ActiveSheet 'Change as appropriate

    Set countRange = ws.Range(Cells(2, "V"), Cells(ws.Range("V2").End(xlDown).Row, "V"))

    Debug.Print countRange.Address

    Dim Cities()
    '<TW> you should really load these from a worksheet....
    Cities = Array("Auckland", "Brisbane", "Melbourne", "Seoul", "Tokyo", "Sydney", _
                    "Bratislava", "Bangalore", "Chennai", "Gurgaon", "Hyderabad")

    Dim city As Long
    Dim counter As Long
    Dim startRange As Range
    Dim r As Variant
    Set startRange = ws.Cells(ws.Range("V2").End(xlDown).Row, "V").Offset(2, 0)

    counter = 2

    For city = LBound(Cities) To UBound(Cities)

        Debug.Print Cities(city)

        'assuming the values to be averaged are in the column to the right of the city names
        '   adjust as required...
        r = Application.AverageIf(countRange, Cities(city), countRange.Offset(0, 1))

        startRange.Offset(counter, 0).Resize(1, 2).Value = Array(r, Cities(city))
        counter = counter + 1

     Next city

End Sub

CountIF和AverageIF是一列

2 个答案: