Selasa, 23 Agustus 2016

Re: [MS_AccessPros] Need to know how many of each digit in a series of unit numbers.

 

John, Crystal and Graham,


Thanks for chiming in. I'm always amazed at how many ways there are to do something. These are all excellent solutions. I was even able to complete the code I started but in the end, I'm using John's function because it was the easiest for me to put in a query and get the individual usage over a date range. I appreciate everyone's input. I will need to do more study on Crystal and Graham's code.


Doyce 



---In MS_Access_Professionals@yahoogroups.com, <JohnV@...> wrote :

Crystal-

Nice code.  Note that in my little function I used the Format function to make sure no leading zeros get dropped when converting the number to a string.  That also ensures I get exactly five digits.

Doyce said he needs the result in a query, but he never posted the SQL, so it's not clear whether he needs one digit counted at a time or the entire result.

John Viescas, author
Effective 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 15:05, crystal 8 strive4peace2008@... [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:

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@... [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 Integer

    D1 = 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, author
Effective 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


__._,_.___

Posted by: winberry.doyce@con-way.com
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (9)

Have you tried the highest rated email app?
With 4.5 stars in iTunes, the Yahoo Mail app is the highest rated email app on the market. What are you waiting for? Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.


.

__,_._,___

Tidak ada komentar:

Posting Komentar