我正在尝试编写一个程序，它将遍历特定列的单元格（由用户分配），在这些单元格中查找新值并计算找到特定值的次数。我现在面临的主要问题是它的硬编码如下：
Function findValues() As Long
For iRow = 2 To g_totalRow
If (ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text = "") Then
nullInt = nullInt + 1
ElseIf (someValue1 = "" Or someValue1 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
someValue1 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
someInt1 = someInt1 + 1
ElseIf (someValue2 = "" Or someValue2 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
someValue2 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
someInt2 = someInt2 + 1
ElseIf (someValue3 = "" Or someValue3 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
someValue3 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
someInt3 = someInt3 + 1
ElseIf (someValue4 = "" Or someValue4 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
someValue4 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
someInt4 = someInt4 + 1
ElseIf (someValue5 = "" Or someValue5 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
someValue5 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
someInt5 = someInt5 + 1
ElseIf (someValue6 = "" Or someValue6 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
someValue6 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
someInt6 = someInt6 + 1
ElseIf (someValue7 = "" Or someValue7 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
someValue7 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
someInt7 = someInt7 + 1
ElseIf (someValue8 = "" Or someValue8 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
someValue8 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
someInt8 = someInt8 + 1
ElseIf (someValue9 = "" Or someValue9 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
someValue9 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
someInt9 = someInt9 + 1
ElseIf (someValue10 = "" Or someValue10 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
someValue10 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
someInt10 = someInt10 + 1
End If
Next iRow
End Function
这里，如果ActiveCell为空，则nullInt将增加，如果ActiveCell具有某个值，则它将找到哪个变量具有相同的值，或者ActiveCell值将被分配给其中一个变量。我为测试目的严格创建了十个变量，但我需要补足一百个变量。我想知道是否有办法快速完成这个。我能想到的唯一方法是创建一个String数组和一个Int数组并以这种方式存储值。但是我不确定这是否是完成这项工作的最佳方式。
修改 这部分专门针对字典。假设有一个标题为“State”的特定列。这包含50个北美州。其中一些状态会重复出现，此列中总共有800个值。如何跟踪德克萨斯被击中的次数？
谢谢，
Jesse Smothermon
答案 0 :(得分：3)
您应该能够使用词典（请参阅Does VBA have Dictionary Structure?）
此代码尚未经过测试，但应该为您提供一个开始。
Function findValues() As Scripting.Dictionary
Dim cellValue
Dim dict As New Scripting.Dictionary
For iRow = 2 To g_totalRow
cellValue = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
If dict.Exists(cellValue) Then
dict.Item(cellValue) = dict.Item(cellValue) + 1
Else
dict.Item(cellValue) = 1
End If
Next iRow
Set findValues = dict
End Function
Sub displayValues(dict As Scripting.Dictionary)
Dim i
Dim value
Dim valueCount
For i = 1 To dict.count
valueCount = dict.Items(i)
value = dict.Keys(i)
ActiveWorkbook.Sheets(sheetName).Cells(i, 3).Text = value
ActiveWorkbook.Sheets(sheetName).Cells(i, 4).Text = valueCount
Next i
End Sub
Sub RunAndDisplay()
Dim dict
Set dict = findValues
displayValues dict
End Sub
答案 1 :(得分：1)
我为你起草了一个代码，希望它有所帮助。我添加了评论，让每个步骤都更加清晰。我相信只需在第一步中设置正确的值就可以使它适合您。
但是，值得了解代码在将来为您提供的帮助。
希望它符合您的需求！
Option Explicit
Sub compareValues()
Dim oSource As Excel.Range
Dim oColumn As Excel.Range
Dim oCell As Excel.Range
Dim sBookName As String
Dim sSheetCompare As String
Dim sSheetSource As String
Dim sUserCol As String
Dim sOutputCol As String
Dim sFirstCell As String
Dim vDicItem As Variant
Dim sKey As String
Dim iCount As Integer
Dim sOutput As String
Dim oDic As Scripting.Dictionary
'1st - Define your source for somevalues and for the data to be compared
sBookName = "Book1"
sSheetCompare = "Sheet1"
sSheetSource = "Sheet2"
sFirstCell = "A1"
sOutputCol = "C"
'2nd - Define the 'somevalues' origin value; other values will be taken
' from the rows below the original value (i.e., we'll take our
' somevalues starting from sSheetSource.sFirstCell and moving to the
' next row until the next row is empty
Set oSource = Workbooks(sBookName).Sheets(sSheetSource).Range(sFirstCell)
'3rd - Populate our dictionary with the values beggining in the sFirstCell
populateDic oSource, oDic
'At this stage, we have all somevalues in our dictionary; to check if the
' valuesare as expected, uncomment the code below, that will print into
' immediate window (ctrl+G) the values in the dictionary
For Each vDicItem In oDic
Debug.Print vDicItem
Next vDicItem
'4th - ask the user for the column he wants to use; Use single letters.
' E.g.: A
sUserCol = InputBox("Enter the column the data will be compared")
'5th - scan the column given by the user for the values in the dictionary
Set oColumn = Workbooks(sBookName).Sheets(sSheetCompare).Columns(sUserCol)
'6th - Now, we scan every cell in the column
For Each oCell In oColumn.Cells
sKey = oCell.Value
'7th - Test the special case when the cell is empty
If sKey = "" Then oDic("Empty") = oDic("Empty") + 1
'8th - Test if the key value exists in the dictionary; if so, add it
If oDic.Exists(sKey) Then oDic(sKey) = oDic(sKey) + 1
'9th - Added to exit the for when row reaches 1000.
If oCell.Row = 1000 Then Exit For
Next oCell
'10th - Now, we print back the counters we found, only for sample purposes
' From now on, is up to you how to use the dictionary :)
iCount = 1
Set oColumn = Workbooks(sBookName).Sheets(sSheetCompare).Columns(sOutputCol)
Set oCell = oColumn.Cells(1, 1)
For Each vDicItem In oDic
If oDic(vDicItem) > 0 Then
oCell.Value = vDicItem
oCell.Offset(0, 1).Value = oDic(vDicItem)
Set oCell = oCell.Offset(1, 0)
End If
Next vDicItem
End Sub
Sub populateDic(ByRef oSource As Excel.Range, _
ByRef oDic As Scripting.Dictionary)
'Ideally we'd test if it's created. Let's just set it for code simplicity
Set oDic = New Scripting.Dictionary
'Let's add an 'empty' counter for the empty cells
oDic.Add "Empty", 0
While Len(oSource.Value) > 0
'If the data is not added into somevalues dictionary of values, we add
If Not oDic.Exists(oSource.Value) Then oDic.Add CStr(oSource.Value), 0
'Move our cell to the next row
Set oSource = oSource.Offset(1, 0)
Wend
End Sub