VBA Excel Counting Specific Values
I'm trying to write a program that will loop through cells of a specific column (assigned by the user), find new values in those cells and count how many times a specific value is found. The main problem I'm having right now is that this is hard-coded like below:
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) Th开发者_JS百科en
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
Here, if the ActiveCell is blank then the nullInt will get incremented, if the ActiveCell has some value then it'll find which of the variables has that same value or the ActiveCell value will be assigned to one of the variables. I created ten variables strictly for testing purposes but I need to make up to one hundred. I was wondering if there was a way to complete this quickly. The only way I could think of was to create a String array and an Int array and store the values that way. However I'm not sure if this is the best way to get this done.
Edit This portion is directed specifically to dictionaries. Say there is a specific column titled "State". This contains the 50 North American states. Some of these states are repeated and there is a total of 800 values in this column. How do I keep track of how many times (for example) Texas gets hit?
Thank you,
Jesse Smothermon
You should be able to do this with a Dictionary (see Does VBA have Dictionary Structure?)
This code hasn't been tested but should give you a start.
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
I've drafted a code for you, hope it helps. I added comments to make each step clearer for you. I believe that simply setting the proper values in the 1st step might make it work for you.
Still, would worth to understand what the code does to help you in the future.
Hope it fits your needs!
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
精彩评论