Cool piece of code Crystal. I bet you had fun writing it. J
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Monday, August 22, 2016 3:06 PM
To: MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] Need to know how many of each digit in a series of unit numbers.
Hi Doyce,
I used another way to count characters -- also wrote a function to loop through the records of a table in a field and count digits ... and the first program is to run it. Just change your tablename and fieldname :)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ START CODE
Sub runHowManyOfEachDigit()
Dim sTablename As String _
, sFieldname As String
sTablename = "MyTablename" '----- customize
sFieldname = "MyFieldname" '----- customize
Call HowManyOfEachDigit(sTablename, sFieldname)
End Sub
Public Sub HowManyOfEachDigit( _
psTablename As String _
, psFieldname As String)
'loop through the records of a table in a field
'and count occurrences of each digit
'for instance: to buy sign letters
's4p 160822
On Error GoTo Proc_Err
Dim db As DAO.Database _
, rs As DAO.Recordset
Dim sSQL As String _
, sMsg As String _
, i As Integer _
, j As Integer _
, s2Check As String _
, nRecords As Long
Dim asDigit(0 To 9) As String * 1
Dim anNumberOf(0 To 9) As Long
'assign values to asDigit and anNumberOf
i = 0
For j = 48 To 57
asDigit(i) = Chr(j)
anNumberOf(i) = 0
i = i + 1
Next j
Set db = CurrentDb
sSQL = "SELECT [" & psFieldname & "] as TheField" _
& " FROM [" & psTablename & "]" _
& " WHERE not ([" & psFieldname & "]) Is Null" _
& ";"
Set db = CurrentDb
Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)
nRecords = 0
With rs
Do While Not .EOF
nRecords = nRecords + 1
s2Check = !TheField
Debug.Print s2Check
For i = LBound(asDigit) To UBound(asDigit)
anNumberOf(i) = anNumberOf(i) + Get_CountChar(s2Check, asDigit(i))
Next i
'goto next record
.MoveNext
Loop
.Close
End With
Set rs = Nothing
Set db = Nothing
sMsg = "Number of each digit from " & Format(nRecords, "#,##0") & " records:"
For i = LBound(asDigit) To UBound(asDigit)
sMsg = sMsg & vbCrLf & asDigit(i) & Space(3) & anNumberOf(i)
Next i
'write to debug window and give user a message
Debug.Print sMsg
MsgBox sMsg, , "Done"
Proc_Exit:
On Error Resume Next
'release object variables
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
Set db = Nothing
Exit Sub
Proc_Err:
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " HowManyOfEachDigit "
Resume Proc_Exit
' Ctrl-Break the MsgBox... then Debug
' then set Resume to be the next statement by right-clicking on it
' and choosing Set Next Statement from the shortcut menu
' Press F8 to step through code one line at a time to see what is wrong
Resume
End Sub
'~~~~~~~~~~~~~~~~~
Public Function Get_CountChar(pvString2Search As Variant, psCharSearchFor As String)
'strive4peace
On Error GoTo Proc_Err
'initialize return value
Get_CountChar = 0
If IsNull(pvString2Search) Then Exit Function
Get_CountChar = UBound(Split(pvString2Search, psCharSearchFor))
Proc_Exit:
On Error Resume Next
Exit Function
Proc_Err:
Resume Proc_Exit
End Function
'~~~~~~~~~~~~~~~~~
Public Function Get_CountWord(pvString2Search As Variant, psSearchFor As String) As Integer
'160819 strive4peace
On Error GoTo Proc_Err
'initialize return value
Get_CountWord = 0
If IsNull(pvString2Search) Then Exit Function
'dimension variable
Dim nPos As Long
'initialize variable
nPos = 0
'count number of occurrences
Do While True
nPos = InStr(nPos + 1, pvString2Search, psSearchFor)
If nPos = 0 Then Exit Function
Get_CountWord = Get_CountWord + 1
Loop
Proc_Exit:
On Error Resume Next
Exit Function
Proc_Err:
Resume Proc_Exit
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ END CODE
respectfully,
crystal
~ have an awesome day ~
On 8/22/2016 8:03 AM, winberry.doyce@con-way.com [MS_Access_Professionals] wrote:
Good morning John,
For what I'm trying to do, your solution works fine. I was playing with this function and it was giving me the numbers I want in debug.print but I didn't know how to get them back to the query. I used the value of 3 because each trailer has the unit number on it in 3 places.
Public Function CountDigits(UNITID As String)
Dim D1 As Integer
Dim D2 As Integer
Dim D3 As Integer
Dim D4 As Integer
Dim D5 As Integer
Dim TL0 As Integer
Dim TL1 As Integer
Dim TL2 As Integer
Dim TL3 As Integer
Dim TL4 As Integer
Dim TL5 As Integer
Dim TL6 As Integer
Dim TL7 As Integer
Dim TL8 As Integer
Dim TL9 As IntegerD1 = Left(UNITID, 1)
D2 = Mid(UNITID, 2, 1)
D3 = Mid(UNITID, 3, 1)
D4 = Mid(UNITID, 4, 1)
D5 = Mid(UNITID, 5, 1)TL0 = 0
TL1 = 0
TL2 = 0
TL3 = 0
TL4 = 0
TL5 = 0
TL6 = 0
TL7 = 0
TL8 = 0
TL9 = 0
Select Case D1
Case 0
TL0 = TL0 + 3
Case 1
TL1 = TL1 + 3
Case 2
TL2 = TL2 + 3
Case 3
TL3 = TL3 + 3
Case 4
TL4 = TL4 + 3
Case 5
TL5 = TL5 + 3
Case 6
TL6 = TL6 + 3
Case 7
TL7 = TL7 + 3
Case 8
TL8 = TL8 + 3
Case 9
TL9 = TL9 + 3
End Select
Select Case D2
Case 0
TL0 = TL0 + 3
Case 1
TL1 = TL1 + 3
Case 2
TL2 = TL2 + 3
Case 3
TL3 = TL3 + 3
Case 4
TL4 = TL4 + 3
Case 5
TL5 = TL5 + 3
Case 6
TL6 = TL6 + 3
Case 7
TL7 = TL7 + 3
Case 8
TL8 = TL8 + 3
Case 9
TL9 = TL9 + 3
End Select
Select Case D3
Case 0
TL0 = TL0 + 3
Case 1
TL1 = TL1 + 3
Case 2
TL2 = TL2 + 3
Case 3
TL3 = TL3 + 3
Case 4
TL4 = TL4 + 3
Case 5
TL5 = TL5 + 3
Case 6
TL6 = TL6 + 3
Case 7
TL7 = TL7 + 3
Case 8
TL8 = TL8 + 3
Case 9
TL9 = TL9 + 3
End Select
Select Case D4
Case 0
TL0 = TL0 + 3
Case 1
TL1 = TL1 + 3
Case 2
TL2 = TL2 + 3
Case 3
TL3 = TL3 + 3
Case 4
TL4 = TL4 + 3
Case 5
TL5 = TL5 + 3
Case 6
TL6 = TL6 + 3
Case 7
TL7 = TL7 + 3
Case 8
TL8 = TL8 + 3
Case 9
TL9 = TL9 + 3
End Select
Select Case D5
Case 0
TL0 = TL0 + 3
Case 1
TL1 = TL1 + 3
Case 2
TL2 = TL2 + 3
Case 3
TL3 = TL3 + 3
Case 4
TL4 = TL4 + 3
Case 5
TL5 = TL5 + 3
Case 6
TL6 = TL6 + 3
Case 7
TL7 = TL7 + 3
Case 8
TL8 = TL8 + 3
Case 9
TL9 = TL9 + 3
End Select
Debug.Print "TL0 = " & TL0
Debug.Print "TL1 = " & TL1
Debug.Print "TL2 = " & TL2
Debug.Print "TL3 = " & TL3
Debug.Print "TL4 = " & TL4
Debug.Print "TL5 = " & TL5
Debug.Print "TL6 = " & TL6
Debug.Print "TL7 = " & TL7
Debug.Print "TL8 = " & TL8
Debug.Print "TL9 = " & TL9
End Function
Thanks for your help!!
Doyce
---In MS_Access_Professionals@yahoogroups.com, <JohnV@...> wrote :Doyce-
Sure wish our old pal, A.D. Tejpal, was still around - I'm sure he would have an elegant solution.
Do you want all ten counts returned in one function call, or do you want to call the function 10 times?
Simple call for each digit:
intNine = CountDigit(Me.UnitNumber, 9)
Function CountDigit(lngUnit As Long, intDigit As Integer) As Integer
Dim strUnit As String, intCount As Integer, intI As Integer
' Convert the input number to a string
strUnit = Format(lngUnit, "00000")
For intI = 1 To 5
If Mid(strUnit, intI, 1) = intDigit Then intCount = intCount + 1
Next intI
' Return the answer
CountDigit = intCount
End Function
John Viescas, authorEffective SQL
SQL Queries for Mere Mortals
Microsoft Office Access 2010 Inside Out
Microsoft Office Access 2007 Inside Out
Building Access Applications
On Aug 22, 2016, at 06:18, winberry.doyce@... [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:
Hello Pros,
At my work, we are engaged in a project where we are replacing the unit numbers on groups of trailers. I need a function that will take the unit number and tell me how many of each digit there are, for example unit number 44095 has 1 zero, 2, fours, 1, five and 1 nine. All the unit numbers have five digits. I'm not sure how to approach this. I know how to extract each digit from the unit number and I assume I should use a select case statement to return the value. But I'm not sure how to put it together and get the totals back from the function. I appreciate all help I receive.
Doyce
This email (and all attachments) is for the sole use of the intended recipient(s) and may contain privileged and/or proprietary information. Any unauthorized review, use, disclosure or distribution is prohibited. If you are not the intended recipient, please contact the sender by reply e-mail and destroy all copies of the original message.
Posted by: Liz Ravenwood <Liz_Ravenwood@beaerospace.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (6) |
Tidak ada komentar:
Posting Komentar